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Abstract 


This contract provided programming support for the analysis of data from 
the Cloud Absorption Radiometer (CAR). The CAR is a multi-channel 
radiometer designed to measure the radiation field in the middle of an 
optically thick cloud (the diffusion domain). It can also measure the 
surface albedo and escape function. The instrument currently flies on a 
C-131A aircraft operated by the University of Washington. Most of this 
work was performed in support of the FIRE Marine Stratocumulus 
Intensive Field Observation program off San Diego during July 1987 
although earlier flights of the CAR have also been studied. It is 
anticipated that the scientific results stemming from this work will be 
published elsewhere. This report will deal only with the software 
developed and provide a survey of the data received. 



The theoretical foundation for this work is described in King (1981) in 
which a method is presented for determining the single scattering albedo 
of clouds at selected wavelengths in the visible and near-infrared 
wavelength regions. The procedure compares measurements of the ratio 
of the zenith to nadir propagating intensities deep within a cloud layer 
with radiative transfer computations of the same. Analytic formulas are 
derived which explicitly show the dependence of the internal intensity 
ratio on ground albedo, optical depth, single scattering albedo and cloud 
asymmetry factor. The single scattering albedo and cloud asymmetry 
factor enter the solution in such a way that a similarity relationship 
exists between these two parameters, As a result, the accuracy with 
which the single scattering albedo can be determined is dictated by the 
accuracy with which the asymmetry factor can be estimated. A method 
of observation is described whereby aircraft measurements of the zenith 
and nadir propagating intensities can be used to determine the similarity 
parameter as a function of wavelength. Since the fractional absorption of 
a cloud depends on the similarity parameter and not on the single 
scattering albedo and asymmetry factor separately, this poses no severe 
limitation to the method. An accurate knowledge of the ground albedo 
and total optical thickness of a cloud are unnecessary for a solution, 
provided one associates the wavelength for which the intensity ratio is a 
maximum with conservative scattering. Under this internal calibration 
approach, uncertainties in the ground albedo are very nearly compensated 
by uncertainties in the cloud optical thickness. 

King et al. (1986) describes the multi- wavelength scanning radiometer that 
has been developed for measuring the angular distribution of scattered 
radiation deep within a cloud layer. The purpose of the instrument is to 
provide measurements from which the single scattering albedo of clouds 
can be derived as a function of wavelength. The radiometer has a 1° field 
of view and scans in the vertical plane from 5° before zenith to 5* past 
nadir (190* aperture) . The thirteen channels of the CAR are located 
between 0 . 5 and 2 . 3 pm and were selected to avoid the molecular 
absorption bands in the near-infrared. The first seven channels of the 
radiometer are simultaneously and continuously sampled, while the eighth 
registered channel is selected from among the six channels on a filter 
wheel. 

The processing of the CAR data is performed by a family of programs. 
The principal components are CARASCAN, CARANLYS, and PHIPLOT. 
CARASCAN ingests the raw data from the original flight tapes and 
reformats it. The reformated data can then be viewed using PHIPLOT to 
find desirable data for further study by CARANLYS. Appendix A contains 
program documentation, a five page example of some of the derived cloud 
properties (e.g. scaled optical thickness and similarity parameter), five 
quick look plot examples, and a listing of CARANLYS. Appendix B contains 
an example of a small part of a plot produced by PHIPLOT and a listing of 
PHIPLOT. PHIPLOT is internally documented. CARANLYS is the heart of 


the data analysis. The version of CARANLYS presented In this report is 
the 7/5/88 version. It has 4 modes of operation. 

Mode 0 performs data quality control tests for all the scan lines. It 
categorizes the data for each scan line Into one of five groups. This 
quality category number (0-4) in conjunction with the plots of phi, the 
ratio of the of the upward and downward propagating intensities (from 
program PHIPLOT), and other plots produced by CARANLYS (see mode 1 
below) permit the user to determine sections of data suitable for various 
forms of analysis including calculating the similarity parameter and 
surface albedo. 

Mode 1 produces a variety of quick-look plots for the whole scan line range 
of the flight or subsets of the data if required. Modes 2 and 3 analyze 
selected subsets of the data for spectral surface albedo and spectral 
similarity parameter respectively. 

Table 1-1 and 1-2 provides a log of all flights of the CAR from Jan. 12, 
1984 through July 16, 1988. It includes information concerning the 
duration of the flight, how many data of various types were collected 
(columns “Total”, “Valid Roll”, and “Diffusion Domain”), and a brief 
comment concerning the data quality and quantity. Table 2-1, 2-2, and 
2-3 provides a more detailed summary of available diffusion domain data 






Scan lines containing diffusion domain data 
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Scan lines containing diffusion domain data 


CO 

I 

C\J 


c 

<D 

£ 

£ 

o 

u 

0) , 
W)| 


£ 

CJ 

CO 



3 


»— t 

CO 

rH 

0 


a> 

- ^ 
Q 


tN 

00 

<T\ 


VO 


_ CO 

boo 

CO 


Table 



References 


King, M. D., 1981: A Method for Determining the Single Scattering Albedo 
of Clouds Through Observation of the Internal Scattered Radiation 
Field. J. Atmos. Sci., 38, 2031-2044. 

, M. G. Strange, P. Leone and L. R, Blaine, 1986: Multiwavelength 

Scanning Radiometer for Airborne Meaurements of Scattered Radiation 
within Clouds. J Atmos. Oceanic Tech., 3, 513-522. 


Appendix A 


CARANLYS 


Program Documentation 
Example of Some Results 
Five Quick Look Plot Examples 
Program Listing 



Program name: CARANLYS 

\ 

Authors: Michael D. King 

Howard G. Meyer 

Date written: January 1985 (revised April 1988) 

Reference: King, M. D., 1981: ]. Atmos. Sci., 38, 2031-2044. 

King, M. D., and Harshvardhan, 1986: J. Atmos. Sci., 43, 784- 
801. 

King, M. D., M. G. Strange, P. Leone and L. R. Blaine, 1986: J. 
Atmos. Oceanic Tech., 3, 513-522. 

Objective: To determine the similarity parameter of clouds from inter- 

nal scattered radiation measurements. 


I. Procedure 

A. Run program CARANLYS following program CARASCAN, which 
writes a data tape containing data from the active scan portion of each 
scan line, together with the time, aircraft roll, filter wheel position, 
condensation status indicator, thermistor temperatures, and other 
housekeeping data from the Cloud Absorption Radiometer. Deter- 
mine the surface albedo and standard deviations for each channel of 
the CAR by running program CARANLYS once for a section of data 
beneath a cloud. The control card images and deck structure for run- 
ning program CARANLYS are contained in Figure 62. 

B. The input data file should have the following form: 


MODE 

WVL(l) 


WVL (13) 

CALSLP (1) 

... 

CALSLP (13) 

CALINT (1) 

... 

CALINT (13) 

AGO (1) 

... 

AGO (13) 

SIGAG(l) 
IPRINT 
ISCAN1 (1) 
* 

ISCAN2 (1) 

• 

SIGAG (13) 

9 

• 

ISCAN1 (N) 

m 

m 

ISCAN2 (N) 


where. 



MODE 

Mode of data processing 


0 Perform quality control tests for all scan lines 

1 Create plots for all scan lines and selected channels 


CARANLYS 


WVL 

CALS LP 

CALINT 

AGO 

SIGAG 

IPRINT 

ISCAN1 

ISCAN2 


2 Derive spectral ground albedo and plot results 

3 Derive spectral similarity parameter using individual 
scan lines and plot results 

Array of wavelengths in pm 

Array of calibration slopes in mW cm -2 pm -1 sr* 1 V' 1 

Array of calibration intercepts in mW cm -2 pm* 1 sr 1 

Array of ground albedo A g 

Array of ground albedo standard deviations 

Dummy variable for input compatibility with program 

PHIPLOT 

Array of first scan lines to be processed 
Array of last scan lines to be processed 


The formats of the input card images are: 


cards 1-5 - 7F10.0 
card 6-N - 7110 


C The output consists of the ratio of the nadir to zenith intensities for 
each scan and channel of the CAR for the specified scan lines, together 
with the scaled optical thickness between the aircraft flight level and 
the base of the cloud t = t(l-g)(tc-x)] and the similarity parameter s = 
[(1-coo) /(1-coog)] 1 / 2 at 12 of 13 channels of the CAR. Standard devia- 
tions of t and s(X) are also calculated. 

Comments 

A. Program dimension statements valid for 20000 scan lines, 13 wave- 
lengths, 50 segments of data, and up to 1000 data points on an individ- 
ual plot. These values can readily be altered in the parameter state- 
ment of the main program. 


Optical thickness and similarity parameter for 10 July 1987 (931-941 PDT) 
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Optical thickness and similarity parameter for 10 July 1987 (931-941 PDT) 
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PROGRAM CARANLYS - 07/05/88 
PURPOSE 

ANALYZE CLOUO ABSORPT I ON RRD IOMETER DRTfi 


DESCRIPTION OF PARAMETERS 

MODE - MODE OF DRTfl PROCESSING 

0 PEFFORM QURLITY CONTROL TESTS FOR ALL SCAN LINES 

1 CREATE PLOTS FOR ALL SCAN LINES AND SELECTED CHANNELS 

2 DERIOE SPECTRAL GROW® ALBEDO AND PLOT RESULTS 

3 DERIDE SPECTRAL SIMILARITY PARAMETER USING INDIDIDURL 
SCAN LINES AND PLOT RESULTS 

UUL - ARRAY OF HADELENGTHS IN MICRONS 

CALSLP - ARRAY OF CALIBRATION SLOPES IN MW/(CM**2-M I CRON-SR-D ) 
CAL I NT - ARRAY OF CALIBRATION INTERCEPTS IN MU/(CM**2-M I CRON-SR ) 
AGO - ARRAY OF GROUND ALBEDOS (UADELENGTH) 

SIGAG - AWAY OF GROUND ALBEDO STANDARD DEVIATIONS (UADELENGTH) 
| PRINT - DUMMY DARI ABLE FOR IhFUT COMPATABILITY WITH PH I PLOT 
I SCAN 1 - ARRAY OF FIRST SCAN LINES TO BE PROCESSED 
ISCAN2 - ARRAY OF LAST SCAN LINES TO BE PROCESSED 

SUBROUTINES AND FUNCTION SIBPROGRAMS REQUIRED 
READ5 

READ AND LIST DATA CARDS AND REUIND INPUT LOGICAL UNIT 5 
CAROAT (MODE, NUMSCN, IPASS, ICH, I ELEC, CALSLP, CAL I NT, 

I SCAN 1, ISCAN2, NFLT, NPASS, NSCAN, KSCAN, ITIME, ROLL, 
INTFLX, KOUNTS, PHI, NCH8) 

AERO AIRCRAFT DATA FOR SCAN LINES BETWEEN I SCAN 1 AND ISCAN2 
STDED (X, NX, XBAR, SIGX) 

CALCULATE MEAN AND STANDARD DEDIATION OF X ARRAY 
FINDS (TSTAR, PHIBAR, AG, SUAL) 

I NTERPOLATE S Ah® PHI ARRAYS USING SPLINE UNDER TENSION 
SEZMXY (LABG, LABX, LABY, X, Y, NPTS, MANY, IDXY, LTYP, LROU, 
LBAC, NPAT, SYMBOL, XMIN, XMAX, YMIN, YMAX) 

MAKE AN X-Y PLOT MIXING CURDES AND SYMBOLS, OR JUST SYMBOLS 
ALONE, OR JUST CURDES ALONE, USING NCAR AUTOGRAPH ROUTINES 

DESCRIPTION OF INPUT DATA DECK 
MODE 

UDL(1) ... UDL<13) 

CALSLP < 1 ) . . . CFLSLP< 13 > 

CALINT(I) . . . CALINT< 13) 

AGOd) . . • AGO< 13) 

SIGAGd) . . . SIGAG< 13) 

IPRINT 

ISCANK1) ISCAN2< 1 ) 


I SCAN 1 (NPASS) ISCAN2(NPASS> 

COMMENTS 

DIMENSION STATEMENTS DAL ID FOR NSCN UP TO NUMSCN 

DIMENSION STATEMENTS DAL ID FOR NPASS UP TO IPASS 

DIMENSION STATEMENTS UAL ID FOR NCHAN UP TO ICH 

DARI ABLE INTFLX CONTAINS IF AND DOW FLUXES FOR MODE = 2, AND 
INTENSITIES AT 0 AND 180 DEGREES FOR ALL OTHER MOOE'S 


000 nonnooooooooonooooonoooo 


MOO I F I CRT I OHS 

8/18/86 - TO 7/31/85 VERSION, ROD MANUAL GRIN ADJUSTMENT AND 
TIED DOWN COSINE COMPRR I SON FOR DATA URLIORTION 
7/02/87 - TO 8/18/86 VERSION, IMPLEMENT QUALITY CONTROL TESTS 
IN SUBROUTINE VALID8 

3/23/88 - TO 7/02/87 VERSION, ADD UP/DOUN ARRAYS WO STATISTICS 
AND PLOTTING (SEZMXY FROM WJW) 

4/04/88 - TO 3/23/88 VERSION, ADO f£W MODE TO GET QUICK LOOK 
PLOTS FOR ALL SCAN LINES (NEW MODE = 1) WO MAKE 
PROGRAM MOSTLY SINGLE PRECISION 
5/09/88 - TO 4/04/88 VERSION, ADD MODE TO PROCESS INDIVIDUAL 
SCAN LINES AND PLOT RESULTS (NEW MODE = 3) 

6/22/88 - TO 5/09/88 VERSION, ADD SUBROUTINE INTGR8 TO INTEGRATE 
TIC INTENSITIES FOR EACH SCAN TO GET UPWARD AND DOWN- 
WARD FLUXES FOR MODE 2 < GROUND ALBEDO CALCULATIONS) 
7/05/88 - TO 6/22/88 VERSION, ADD WAVELENGTH DEPENDENCE OF 
OPTICAL THICKNESS TO MODE 3 (DATA ANALYSIS) 

REFERENCES 

KING, M. D., 1981: J. ATMOS. SCI., 38, 2031-2044. 

KING, M. 0., M. G. STRRNGE, P. LEONE, AND L. R. BLAINE, 1986: 

J. ATMOS. OCEAN. TECH., 3, 513-522 

PARAMETER (NUMSCN = 16000, IDXY = 1000) 

PARAMETER < I PASS =50, ICH = 13, I ELEC = 8, MRXCRV = 3) 

CHARACTER*! SYMBOL (MRXCRV) 

CHRRACTER*60 LABG,LABX,LABV 

DOUBLE PRECISION X< IDXY, MRXCRV >,V< IDXY, MRXCRV) 

DOUBLE PRECISION XMIN,XMAX,YMIN,YMAX 
REAL *4 I NTFLX< NUMSCN, I ELEC, 2 ) 

DIMENSION KOUfrS<rflJMSCN, I ELEC, 2) 

DIMENSION PHI (fflJMSCN, IELEC),T(NUMSCN, ICH),S<NUMSCN, ICH) 

DIMENSION PH I B< ICH, IPASS), S IGP< ICH, I PRSS >,LSCN1( ICH, I PASS) 
DIMENSION SMEWK ICH, IPASS),SIGS< ICH, IPASS) 

DIMENSION KSCWK NUMSCN), I T I ME ( NUMSCN ) , RCLL < NUMSCN ) , NCH8 ( NUMSCN ) 
DIMENSION RRTIO(NUMSCN),UP(NUMSCN>,DN(NUMSCN>,TUALUE(NUMSCN) 

D I MENS I ON SVALUE(NUHSCN ), I SCAN 1 ( IPASS 5, ISCAN2CIPASS ), NSCANC I PASS ) 
DIMENSION TMEWKICH, IPASS), SIGT( ICH, IPASS),TAU< ICH, IPASS) 

DIMENSION SIGTRUdCH, IPASS),NPTS(MAXCRV),RECG< ICH),LSCN< ICH) 
DIMENSION WVL< ICH),CALSLP( ICH),CALINT< ICH), AGO( ICH),SIGAG( ICH) 
DIMENSION G< ICH),TSPEC< ICH),TPSPEC< ICH),PHIAUG( ICH),SIGAVG( ICH) 
DATA W/0.714/, I SCEND/O/, LSCN 1 /650*0/ 

DATA G/0. 85334, 0.84675, 0.843 17, 0.8388 1,0. 83280, 0.82677, 

1 0. 82452, 0.8 1344, 0.80855, 0.80543, 0.80339, 0.79775, 

2 0.80170/ 

DATA TSPEC/ 14.282, 14.475, 14.553, 14.678, 14.843, 15.007, 

1 15.055, 15.323, 15.402, 15.465, 15.683, 15.920, 

2 16.085/ 

NCHAN = ICH 

CALL READS 

CALL NCVIEW (-0.77) 

INITIALIZE SPECTRAL SCALED OPTICAL THICKNESS ARRAY 

DO 5 NC = 1, NCHAN 

RECG(NC) = 1.0 / (1.0 - G(NC>) 

TPSPEC(NC) = (1.0 - G(NC» * TSPEC (NC) 



oon ooo ooo ooooo ooo 


5 CONTINUE 

REF® INPUT DfiTR 

REflO (5, 1000) MODE 

READ (5,1010) (WVL(NC),NC=1, ICH) 

READ (5,1010) (CflLSLP<NC),NC=1, ICH) 

REftO (5,1010) (CALINT(NC),NC=1,ICH) 

READ (5,1010) (RG0(NC),NC=1, ICH) 

REftO (5,1010) (SIGRG(NC),NC=1, ICH) 

READ (5,1000) I PRINT 

CALL CRRDAT (NODE, NUNSCN, I PASS, ICH, I ELEC, CALSLP, CAL I NT, 

1 I SCAN 1, ISCAN2, NFLT, NPASS, NSCAN, KSCAN, ITINE, 

2 ROLL, INTFLX, KOUNTS, PHI, NCH8) 

IF NOTE = 0, PROCESS CHANNEL 1 DATA TO GET OUTPUT TABLE SHOUING 
THE TlltS AT WHICH THE CLOUD ABSORPTION RADIOMETER OBSERVATIONS 
ARE IN THE DIFFUSION DOMAIN 

IF (MODE .EQ. 0) NCHAN = 1 

BEGIN ANALYSIS OF AIRCRAFT DATA FOR EACH GROUP OF SCAN LINES 

DO 140 NP = 1, NPASS 
NSCN = NSCflN(NP) 

ISCSTR = ISCEND + 1 
ISCEND * ISCEND + NSCN 
IF (NSCN .LT. 2) GO TO 140 
DO 20 I = 1, IDXY 

X(l, 1) * ISCANKNP) +1-1 
DO 10 J = 1,MAXCRU 
Y( I , J) * 1 .00+36 
10 CONTINUE 

20 CONTINUE 

BEGIN ANALYSIS OF AIRCRAFT DATA FOR EACH CHANICL 

DO 120 NC = 1, NCHAN 
NC8 = NC 

IF (NC .GE. I ELEC) NC8 ■ I ELEC 
IF (MODE EQ. 1) GO TO 60 

BEGIN ANALYSIS OF AIRCRAFT DATA FOR EACH SCAN LINE 

LSCAN = 0 
LSCN(NC) = 0 
DO 50 N = ISCSTR, ISCEND 
IF (N EQ. ISCSTR) THEN 
IF (MODE .EQ. 2) THEN 

WRITE (6,1020) NC,NFLT,WUL(NC),AGO(NC),SIGAG(NC), 

1 CALSLP(NC),CALINT(NC) 

ELSE 

WRITE (6, 1030) NC,NFLT,WU-(NC),RGO(NC), 

1 SIGAG(NC),CALSLP(NC),CALINT(NC) 

END IF 

IF (NC .EQ. 1) THEN 

IF (RG0(1) .EQ. 1.0) AG0(1) = 0.0 
DENI = 1.0 - AG0(1) 



non noon noon 


IF (AG0(2) .EQ. 1.0) AG0(2) = 0.0 
0EH2 * 1.0 - AG0(2) 

END IF 
EM) IF 

IF «NC GE. I ELEC) .AND. (NCH8(N) .NE. NC)) GO TO 50 
IF ((PHI (N,NC8) LE. 0.0) .AM). (MODE .GT. 2>> GO TO 50 
IF (LSCAN .GT. 1) THEN 

IF (M00(LSCAN,49> .EQ. 0) THEN 
IF (NODE EQ. 2) THEN 

WRITE (6,1020) NC,NFLT,UUL<NC),RGO(NC), 

1 SIGftG(NC>,CRLSLP<NC),CflLINT<NC) 

ELSE 

URITE(6, 1030) NC,NFLT,UUL(NC),fiG0(NC), 
t SIGfiG<NC),CflLSLP(NC),CRLINT<NC) 

END IF 

END IF 
EM) IF 

LSCflH ® LSCRN +• 1 

LSCN(NC) * LSCflN 

LSCN1(NC,NP) = LSCN1(NC,NP) + 1 

I HR = ITIHE(N)/10000 

IMN1 = ITIME(N) - 10000* I HR 

INN = INN 1/100 

i sec = mm - ioo*inn 

IF <<MOOE EQ. 0) OR. (MODE .EQ. 2)) GO TO 40 

COMPUTE SCALED OPTICAL DEPTH FOR INDIUIDUAL SCAN LINE 
ASSUMING CONSERUATIUE SCATTERING IN CHANNELS 1 OR 2 

IF (NC .GE. 2) GO TO 30 

TCH1 = (1.0 + PHI(N,1» / (1.0 - PHI (N, 1 )) - 
1 4.0 * AG0(1) / (3.0 * DENI ) - QP 

TCH2 = (1.0 + PHI (N,2)) / (1.0 - PHI(N,2» - 
1 4.0 * AG0(2) / (3.0 * DEN2) - QP 

IF (TCH1 .GE. TCH2 * TPSPEC( 1 )/TPSPEC(2>) THEN 
T(N, 1) = TCH1 
S(N, 1) = 0.0 
GO TO 40 
ELSE 

T(N,2) = TCH2 

T(N, 1) = T(N,2) * TPSPEC( 1 )/TPSPEC(2) 

S(N,2) = 0.0 
EM) IF 

COMPUTE SIMILARITY PARAMETER FOR NONCONSERUAT I UE 
CHANNELS 

30 IF ((NC EQ. 2) .AM). (S(N,1) NE. 0.0>) GO TO 40 

AG = AGO(NC) 

IF (AG .EQ. 1.0) AG = 0.0 

T(N,NC) = T(N, 1 ) * TPSPEC(NC )/TPSPEC( 1 ) 

CALL FINOS (T(N,NC), PHI(N,NC8), AG, S(N,NC)) 

PRINT OUT TABLE OF PROCESSED DATA FOR EACH SCAN LINE 

40 IF (MODE EQ. 2) THEN 

WRITE (6,1040) KSCAN(N),ROLL(N), I Ml, IMN, I SEC, 

K0UNTS(N,NC8,2),K0UNTS(N,NC8, 1), 
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2 
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1 

2 
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1 


1 


C 

C 

c 
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60 


1 

2 
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INTFLX(N,NC8,2), INTFLX(N,NC8, 1 >, 

PHI (N,NC8) 

ELSE 

IF (MODE .EQ. 0) THEN 

URITE (6,1040) KSCAN(N),ROLL(N), IHR, INN, ISEC, 

K0UNTS(N,NC8,2),K0UNTS<N,NC8, 1 ), 
INTFLX(N,NC8,2>, INTFLX(N,NC8, 1 ), 
PHI <N,NC8) 

ELSE 

WRITE (6,1040) KSCRN(N),ROLL(N), IHR, IMN, ISEC, 
K0UNTS(N,NC8,2), 

K0UNTS(N,NC8, 1 ), 
INTFLX(N,NC8,2), 

INTFLX(N,NC8, 1 ), 

PHI (N,NC8),T(N,NC),S(N,NC) 

END IF 

END IF 

RRTIO(LSCRN) * PHI(N,NC8) 

UP(LSCRN) = INTFLX(N,NC9,2) 

ON(LSCRN) = INTFLX(N,NC8, 1 ) 

TURLUE(LSCRN) = T(N,NC> 

SURLUE(LSCAN) = S(N,NC) 

CONTINUE 


END ANALYSIS OF AIRCRAFT DATA FOR EACH SCAN LINE 


IF (LSCAN LE. 1) GO TO 120 

CALL STDEU (RATIO, LSCAN, PHIB(NC,NP), SIGP(NC,NP)) 

CALL STDEU (UP, LSCAN, UPNEAN, SIGUP) 

CALL STDEU (DN, LSCAN, DNMEAN, SIGON) 

IF (MOOE GT. 2) THEN 

CALL STDEU (TUALUE, LSCAN, TMEAN(NC,NP), SIGT(NC,NP)) 
CALL STDEU (SUALUE, LSCRN, SMEAN(NC,NP>, SIGS(NC,NP)) 
TAU(NC,NP) * RECG(NC) * THEAN(NC,NP> 

SIGTAU(NC,NP) = RECG(NC) * SIGT(NC,NP) 

URITE (6,1050) LSCAN, PH I B(NC,NP),SIGP(NC,NP), UPNEAN, 
SIGUP,DNMEAN,SIGON,TNEAN(NC,NP), 

S I GT(NC, NP ), TAU(NC, NP ), S I GTRU(NC, NP ), 
SltAN(NC,NP),SIGS(NC,NP> 

ELSE 

IF (MODE EQ. 0) HEN 

URITE (6,1055) L5CAN,PHIB(NC,IF),SIGP(NC,NP), 
UPIEAN, S I GUP, DNfEAN, S I GDN 


ELSE 

URITE (6,1060) LSCAN,PHIB(NC,NP),SIGP(NC,NP), 
UPNEAN, S I GUP, DNHEAN, S 1 GDN 

El® IF 


END IF 


PLOT ZENITH AND NADIR PROPAGATING INTENSITIES OR FLUXES 
AS A FUNCTION OF SCAN NUMBER FOR SELECTED CHANNELS 

IF ((MODE EQ. 1) AND. 

((NC .EQ. 1) .OR. (NC .EQ. 2) OR. (NC EQ. 3) OR. 
(NC EQ. 9) .OR. (NC .EQ. 12)) .OR. 

(MODE EQ. 2) OR. (MODE EQ. 3)) THEN 
LABX - 'SCAN NUMBER! ' 

LABY = 'INTENSITY (MI/(CM**2-M I CRON-SR ) )$ ' 


IffilTE (LABG, 1070) NFLT,NC 
IF (MODE .EQ. 2) THEN 

LABY = 'FLUX <MW/<CM**2-MICR0N>>$' 

WRITE (LABG, 1080) NFLT,NC 
END IF 
MANV = 2 
LTVP = 1 
LROU * 1 
LBftC = 1 
NPflT * 1 

DO 70 N = ISCSTR, ISCEND 

LSCAN = KSCflN(N) - ISCANIO'P) + 1 
IF <<NC .GT. 7) .AND. <NCH8(N> .NE. NC)> THEN 
V(LSCRN, 1 > - 1.0D+36 
V(LSCAN,2> * 1.00+36 
Y(LSCRN,3> = 1.00+36 
ELSE 

V< LSCRN, 1 ) = INTFLX(N,NC8, 1) 

Y(LSCAN,2) = INTFLX(N,NC8,2) 

V(LSCRN,3) = PHI <N,NC8> 

END IF 
CONTINUE 

XMIN = ISCRNKNP) 

XMAX = ISCRN2(NP> 

VMIN = 1.00-4 

VMRX = 0.000 

NPTS( 1 ) * ISCWCO**) - ISCRNKNP) + 1 

NPTS<2> * NPTS< 1 > 

SVMB0L<1> = ‘L‘ 

SVMB0L<2) = 'L' -liz 

CALL SE2MXV (LABG, LABX, LABY, X, V, NPTS, MANV, IDXY, 
LTVP, LROU, LBAC, NPAT, SYMBOL, XMIN, XMAX, 
VMIN, VMRX) 

PLOT INTENSITY RATIO OR GROUNO ALBEDO AS A FUNCTION OF 
i^AN NUMBEI^FOR A SINGLE CHRN1EL 

WRITE (LABG, 1090) NFLT,NC 
LABV' = ' PH 1$ * 

IF (MODE .EQ. 2) THEN 

URITE (LABG, 1100) NFLT,NC 
LABV = ‘GROUND ALBEDOS ' 

END IF 
MANV = 1 
NPHIGD = 0 

DO 80 N = ISCSTR, ISCEND 

LSCAN = KSCAN(N) - ISCRNKNP) + 1 
IF ((Y(LSCAN,3) LE. O.ODO) .OR. 

(V(LSCAN,3) .GE. 1.0D0)) T«N 
V( LSCAN, 1 ) = 1.00+36 
ELSE 

NPHIGD = NPHIGD + 1 
V(LSCRN, 1) = Y(LSCRN,3> 

END IF 
CONTINUE 

VMIN = 1.0D-4 

VMAX * 1.0D0 

IF (hPHIGO .GT. 0) 
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C 

C 
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C 


1 
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1 

2 


120 


CflLL SEZMXV (LflBG, 

LRBX, 

LflBV, 

X, V, 

NPTS, 

MRNV, 

IDXV, 

LTVP, 

LROW, 

LBRC, 

NPRT, 

SVMBOL 

XMIN, 

XMRX, 

VMIN, 

VMflX) 



PLOT SCALED OPTICAL 

DEPTH 

RTO OPTICflL DEPTH 

AS R 


FUNCTION OF SCfiN NUMBER 

IF <MODE .NE. 3) GO TO 120 
IF <NC .EQ. 1> THEN 

WRITE (LflBG, 1110) NFLT,NC 

LRBV = 'SCRLED OPTICAL DEPTH (TOTAL - fl I RCRRFT )$ ' 

DO 90 N = ISCSTR, ISCEM) 

LSCRN = KSCfiN(N) - ISCflNKNP) + 1 
V(LSCflN, 1) = T(N, 1 ) 

CONTINUE 
VNIN = 1.00-4 
VMflX = 0.000 

CALL SEZMXV (LRBG, LRBX, LRBV, X, V, NPTS, MRNV, IDXV, 
LTVP, LROW, LBRC, NPRT, SVMBOL, XMIN, 
XMRX, VMIN, VMflX) 

WRITE (LRBG ,1 120) NFLT,NC 

LflBV = 'OPTICAL DEPTH (TOTAL - AIRCRAFT )$' 

00 100 N * ISCSTR, ISCEND 

LSCRN = KSCRN(N) - I SCAN 1 (NP ) + 1 
V(LSCRN, 1 ) = RECG( 1 ) * T(N, 1 ) 

CONTINUE 
VMIN = 1.00-4 
VMflX = O.ODO 

CALL SEZMXV (LRBG, LflBX, LflBV, X, V, NPTS, MRNV, IDXV, 
LTVP, LROW, LBRC, NPRT, SYMBOL, XMIN, 
XHflX, VMIN, VMflX) 

END IF 

PLOT SIMILRRITV PARfttETER AS fl FUNCTION OF SCAN NUMBER 
FOR fl SINGLE CHANNEL 

WRITE (LRBG, 1130) NFLT,NC 
LflBV = •SIMILRRITV PRRfffETERl' 

DO 110 N = ISCSTR, ISCEND 

LSCRN = KSCRN(N) - ISCANKNP ) + 1 
IF ((V(LSCflN,3) .LE. O.ODO) .OR. 

(V(LSCflN,3) .GE. 1 .MW)) THEN 
V(LSCRN, 1) = 1.0D+36 
ELSE 

V(LSCflN, 1) = S(N,NC> 

END IF 
CONT I NLE 
VMIN = 1.0D-4 
VMflX = 1.0D0 

CflLL SEZMXV (LflBG, LRBX, LflBV, X, V, NPTS, MRNV, 

IDXV, LTVP, LROW, LBRC, NPRT, SVMBOL, 

XMIN, XMRX, VMIN, VMflX) 

END IF 
CONTINUE 

END ANfiLVSIS OF RIRCRRFT DATA FOR EACH PflSS, ALL CHANNELS 


C 

C 

C 


IF (MODE .NE. 1) THEN 


ooooo non 


1 

2 

3 
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IF (MODE .EQ. 2) THEM 

WRITE <20, 1000) ISCANKfP), ISCAN2(NP> 

WRITE (20,1010) <PHIB(NC,rP),NC=*1,ICH) 

WRITE (20,1010) <SIGP(NC,NP),NC= 1, ICH) 

WRITE (6,1140) HFLT, ISCRNKNP), ISCflH2(MP) 

ELSE 

WRITE (6,1150) NFLT, ISCRNKNP), ISCRM2(MP) 

END IF 

DO 130 NC = 1,NCHRM 

IF (MODE .EQ. 2) TIEN 

WRITE (6,1160) NC,WUL(NC),LSCNKNC,NP),PHIB<NC,NP), 
SIGP(NC,NP) 

ELSE 

IF (MODE EQ. 0) THEN 

WRITE (6,1160) NC,WUL(NC>,LSCN<NC),PHIB<NC,NP>, 
S I GP<NC, HP ), RG0(NC ), S I GRG(NC ) 

ELSE 

WRITE <6, 1160) NC, 

WW.(MC),LSCM(NC),PHIB(MC,MP), 

S I GP<NC, NP ), AGO(NC ), S I GfiG(NC), 
SMERN(HC, NP ), S I GS(NC, UP ), 
TAU(NC, NP ), S I GTRIKNC, IP ) 

END IF 


END IF 

130 CONTINUE 

END IF 
140 CONTINUE 

END RNRLVSIS OF AIRCRAFT DATA FOR ALL GROUPS OF SCAN LlhCS 
IF (NODE EQ. 1) GO TO 170 

FOR (MODE EQ. 2) AND (NPASS GT. 1), CALCULATE AND PRINT OUT 
SUMMRRY TABLE OF AGO'S AND ERROR’S AUERAGED FOR ALL SCAN LlhE 
RANGES 


IF ((MODE .EQ. 2) AND. (NPASS GT. D) THEN 
WRITE (6,1140) NFLT, ISCANK1), ISCAN2(NPASS) 
DO 160 NC = 1, ICH 
LSC =0 
SUMX = 0.0 
SUMX2 = 0.0 
DO 150 NP = 1, NPASS 
LSCAN = LSCN1(NC,NP) 


LSC * LSC 
SUMX = SUMX 
SUMX2 = SUMX2 


+ LSCAN 

+ LSCAN*PHIB(NC,NP) 

+ (LSCAN - 1.0>*SIGP(NC,NP)*SIGP<1C,NP) 
1 + LSCAN*PH I B(NC, NP )*PH I B(NC, NP > 

150 CONTINUE 

PHIAUG(NC) * SUMX / LSC 

SIGAUG(NC) * SUMX2 - LSC*PH I AUG(NC )*PH I AUG(NC ) 

IF (SIGAUG(NC) .LT. 0.0) SIGAUG(NC) = 0.0 
SIGAUG(rC) = SQRT(SIGAUG(NC) / (LSC - 1.0)) 

WRITE (6,1160) NC J UUL(NC),LSC,PHIftUG(NC),SIGRUG(NC) 

160 CONTINUE 

WRITE (20,1000) I SCAN 1 ( 1 ), I SCAN2(IPASS ) 

WRITE (20,1010) <PHIAUG(NC),NC=1,ICH> 

WRITE (20,1010) (SIGAUG(NC),NC=1,ICH) 



REWIND 23 
ENO IF 

170 WRITE <6, 1170) NODE 
STOP 

1000 F0Rt1flT<7l 10) 

1010 F0RMAT(7F10.4) 

1020 FORMAT ( 1H1, /,9H CHANNEL: , 13, 45X, 14HFLIGHT NUMBER: , 15, /, 

1 12H WAUELENGTH : , F7 . 4, 8H MICR0NS,30X, 14HGR0UND ALBEDO:, F7. 4 

2 4H +/-,F7.4,/,20H CRLIBRRTION SLOPE =,F7.4, 

3 23H MW/(CM**2-M I CRON-SR-U ), 7X, 23HCRL I BRRT I ON INTERCEPT =, 

4 F7.3,21H MW/(CM**2-M I CRON-SR ), //, 2 IX, 4HT INE, 3X, 

5 2(3X,5HC0UNT),6X,8HFLUX(-1),6X,7HFLUX(1),/,6H SCRN,4X, 

6 4mOLL,4X, 10HHR NIN SEC,4X,4H(-1 >,4X,3H( 1 >,7X,8HMU / (CM, 

7 13H**2 - MICRWI),6X,6Hftt.BED0, /, 1X,5< 1H-),3X, 

8 6( 1H-),3X, 10( 1H-),2(3X,5( 1H-)),6X,21( 1H-),6X,6( 1H-)) 

1030 F0RttflT<1H1,/,9H CHRNNEL: , I3,45X, 14HFLIGHT WJMBER: , 15, /, 

1 12H WRUELENGTH :,F7. 4, 8H N I CRONS, 30X, 14HGR0UND ALBEDO :,F7. 4 

2 4H +/-,F7.4,/,20H CALIBRATION SLOPE =,F7.4, 

3 23H MW/(CM**2-M I CRON-SR-U ), 7X, 23HCAL I BRAT I ON INTERCEPT =, 

4 F7.3,21H MU/(CM**2~M I CRON-SR ), //, 2 IX, 4HT I ME, 3X, 

5 2(3X,5HC0UNT),3X,27HINTENSITV(-1) INTENSITV( 1 ), 16X, 

6 6HSCALED,5X, 10HSINILARITV, /,6H SCAN,4X,4HR0LL,4X, 

7 10HHR MIN SEC,4X,4H(-1),4X,3H(1),4X, 11HMM / (CM**2, 

8 16H - HI CRONS - SR),5X,3HPHI ,4X, 13H0PT I CAL DEPTH, 

9 2X, 9HPARAMETER, /, IX, 5( 1H- ), 3X, 6( 1H- ), 3X, 10< 1H- ), 

A 2(3X,5( 1H-)),3X,27( 1H-),3X,6( 1H-),3X, 13<1H-),2X, 10< 1H- ) ) 

1040 F0RMAT(I6,F8.2, 16,214, 17, I8,2F14.4,F12.4,2F13.4) 

1050 FORMAT < 18H0NUNBER OF SCANS =, 16,/, 

1 11H K-1)/K1),5X,2H =,F8.4,4H +/-,F7.4,/, 

2 6H K-1), 10X,2H =,F8.4,4H +/-,F7.4, 

3 21H fftJ/<CN**2-M I CRON-SR >, /, 

4 5H K1>, 11X,2H =,F8.4,4A +/-,F7.4, 

5 21H NW/<CM**2-M I CRON-SR),/, 

6 1 1H SCALED TAU,5X,2H =,F8.4,4H +/-,F7.4, /, 

7 4H TAU, 12X,2H =,F8.4,4H +/-,F7.4,/, 

8 2H S, 14X,2H =,F8.4,4H +/-,F7.4) 

1055 FORMAT< 18H0NUM8ER OF SCANS =, 16, /, 

1 11H 1 <— 1 )/ I < 1 ),5X,2H =,F8.4,4H +/-,F7.4,/, 

2 6H K-1), 10X,2H =,F8.4,4H +/-,F7.4, 

3 21H MU/<CN**2H1 1 CRON-SR),/, 

4 5H K1), 11X,2H =,F8.4,4H +/-,F7.4, 

5 21H m / ( CM**2-M I CRON-SR ) ) 

1060 FORMAT < 18H0NUMBER OF SCANS =, 16,/, 

1 7H ALBEDO, 10X, 1H=,F8.4,4H +/-,F7.4,/, 

2 9H FLUX (UP ), 8X, 1H=, F8 . 4, 4H +/-, F7 . 4, 

3 18H NW/(CM**2-M I CRON ), /, 

4 11H FLUX(D0WN),6X, 1H=,F8.4,4H +/-,F7.4, 

5 18H MW/ <CM**2-M I CRON ) ) 

1070 FCffWIATC ZENITH RND NADIR INTENSITIES FOR FLIGHT', 15, 

1 ' AMD CHANNEL 1 13 * $ ' ) 

1080 FORMAT CUPUARD AND DOWNWARD FLUXES FOR FLIGHT', 15, 

1 ' AW) CHANNEL', 13, ) 

1090 FORMAT ( ' I NTENS I TV RATIO K-D/K+1) FOR FLIGHT', 15, 

1 ' AND CHAW€L', 13, '$' ) 

1100 FORMAT (' GROUND ALBEDO FOR FLIGHT', 15, ' AND CHANNEL' , 13, '$' ) 

1110 FORMAT ('SCALED OPTICAL DEPTH FOR FLIGHT', 15, 

1 ' WO CHANNEL', 13, '$' ) 

1120 F0RMAT( 'OPTICAL DEPTH FOR FLIGHT' , 15, ' AND CHANNEL' , 13, '$' ) 


ooooooonoooooooooo 


1130 F0RMAT< 'SIMILARITY PARAMETER FOR FLIGHT’, 15, ’ AND CHANNEL', 

1 13, '$' ) 

1140 FORMAT < 1H1, /, 15H FLIGHT NLMBER: , 15, /,21H SCAN NUMBER RANGE IS, 

1 I6,3H TO, 16,//, 10X, 10HWAUELENGTH,3X,6HNUMBER,/, IX, 

2 7HCHANNEL, 4X,6HM I CRON, 4X,8H0F SCANS, 7X, 13HGR0UND ALBEDO,/, 

3 1X,7< 1H-),2X, 10< 1H-),2X,8< 1H-),5X, 17( 1H-), /> 

1150 FORMAT* 1H1, /, 15H FLIGHT NUMBER: , 15, /,21H SCAN NUMBER RANGE IS, 

1 16, 3H TO, 16,//, 10X, 1 OHWAUELENGTH , 3X , 6MUMBER , / , 

2 1X,7HCHRNNEL,4X,6HMICR0N,4X,8H0F SCRNS, 12X,3HPHI , 

3 16X, 13HGR0UWD ALBEDO, 7X,20HSIM I LARI TV Pf®AMETER,5X, 

4 17H0PTICRL THICKNESS,/, 1X,7< 1H-),2X, 10< 1H-),2X,8< 1H-),5X, 

5 17< 1H-),2X,2<5X, 17< 1H-»,3< 1H-),5X, 18( 1H-),/) 

1160 FORMAT* 15, F 13. 4, I 10,4<F 13.4,4H +/-,F7.4)> 

1170 FORMAT ( 1H 1 , //, 36H TIC QUALITY CONTROL CATEGORIES ARE:,//, 

1 5H DATA,/, 17H QUAL DEFINITION,/, 1X,4< 1H-),2X, 10<1H-),/, 

2 3X, 1H0,3X, 15HACCEPTRBLE DATA, /, 

3 3X,1H1,3X,40HNR0IR INTENSITY EXCEEDS ZENITH INTENSITY,/, 

4 3X,1H2,3X,38HNUMBER OF TIMES DEUIRTIOMS FROM COSINE, 

5 29H CURUE CHANGE SIGN IS .LE. 3,,/, 

6 7X,32HF0R XMU BETWEEN 0.9 AND -0.9 AND, 

7 44H STANDARD DEUIATION GT. 0.5**STD0EU THRESH),/, 

8 3X, 1H3,3X,39HSAMPLE STANDARD DEUIATION AROUND COSINE, 

9 35H CURUE EXCEEDS 5* OF MEAN AMPLITUDE,/, 

A 3X, 1H4, 3X, 35HMAX I MUM DEUIATION FROM COSINE CURUE, 

B 30H EXCEEDS 10* OF MEAN AMPLITUDE, //, 

C 32H THE MOOE OF DATA PROCESSING IS ,I1,7H WHERE:,//, 

D 55H 0 = PERFORM QUW.ITV CONTROL TESTS FOR ALL SCAN LINES, 

E /,48H 1 = PLOT SELECTED CHANNELS FOR ALL SCAN LINES,/, 

F 53H 2 = DERIUE SPECTRAL GROUND ALBEDO RIO PLOT RESULTS, /, 

G 49H 3 * DERIUE SPECTRAL SIMILARITY PARAMETER USING, 

H 39H INOlUIDUffl. SCAN LINES Aid PLOT RESULTS) 

Eld 

SUBROUTINE REA05 
PURPOSE 

READS AND WRITES INPUT DATA CARDS FROM LOGICAL UNIT 5 
USAGE 

CALL READS 

DESCRIPTION OF PARAMETERS 
NONE 

SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED 
NONE 

COMMENTS 

SUBROUTINE REWINDS LOGICAL UNIT 5 SO THE INPUT IS READY TO BE 
REM) BY THE PROGRAM 

SUBROUTINE READ5 
DIMENSION CARD< 18) 

WRITE <6, 1000) 

10 f®® <5, 1010,EN0=999) CARD 
WRITE <6, 1020) CARD 
GO TO 10 
999 CONTINUE 
REWIND 5 
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RETURN 

1000 FORMAT < 1H1, //, 10X, 'THE CONTENTS OF THE INPUT FILE ON UNIT 5 ARE: ' , 

i m 

1010 FORMAT < 18A4) 

1020 FORMAT < 10X, 18A4) 

END 

SUBROUTINE CARDAT 
PURPOSE 

READ AIRCRAFT DATA FOR SCAN LINES BETWEEN I SCAN 1 AND ISCAN2 
USAGE 

CALL CARDAT <M00E, NUMSCN, I PASS, ICH, I ELEC, CALSLP, CAL I NT, 

I SCAN 1, ISCAN2, NFLT, NPRSS, NSCAN, KSCAN, I T I ME, 
ROE, INTFLX, KOUNTS, PHI, NCH8) 

DESCRIPTION OF PARAMETERS 
MODE - MODE OF DATA PROCESSING 

0 PERFORM QUALITY CONTROL TESTS FOR ALL SCAN LINES 

1 CREATE PLOTS FOR ALL SCAN LINES AND SELECTED CHANNELS 

2 DERIUE SPECTRAL GROUND ALBEDO AND PLOT RESULTS 

3 DERIUE SPECTRAL SIMILARITY PARAMETER USING IhOlUIDUAL 
SCAN LINES AW PLOT RESULTS 

NUMSCN - DIMENSION SPECIFYING THE MAXIMUM NUMBER OF SCAN LINES 
THAT CAN BE PROCESSED 

IPASS - DIMENSION SPECIFYING THE MAXIMUM NUMBER OF SCAN LINE 
SEGMENTS THAT CAN BE PROCESSED 
ICH - DIMENSION SPECIFYING TIC MAXIMUM NUMBER OF OPTICAL 
CHANNELS 

I ELEC - DIMENSION SPECIFYING THE MAXIMUM NUMBER OF ELECTRICAL 
CHANNELS 

CALSLP - ARRAY OF CALIBRATION SLOPES IN MW/<CM**2*M I CRON*SR*U ) 
CAL I NT - ARRAY OF CALIBRATION INTERCEPTS IN MW/<CM**2*M I CRON+SR ) 
I SCAN 1 - ARRAY OF FIRST SCAN LINES TO BE PROCESSED 
ISCAN2 - ARRAY OF LAST SOW LINES TO BE PROCESSED 
NFLT - FLIGHT NUMBER 

NPRSS - NUMBER OF SCAN LINE PAIRS PROCESSED 
NSCAN - ARRAY OF NUMBERS OF SCAN LINE SEGMENTS PROCESSED 
KSCAN - ARRAY OF SCAN LHC NUMBERS PROCESSED 
ITIME - ARRAY OF TIMES OF PROCESSED SCAN LINES 
ROLL - ARRAY OF ROLL ANGLES FOR PROCESSED SCfW LINES 
INTFLX - ARRAY OF INTENSITIES OR FLUXES FOR EACH CHANNEL 
MODE .EQ. 2 

UPWARD ft® DOWNWARD PROPAGATING FLUXES 
MODE HE. 2 

UPWARD WC DOWNWARD PROPAGATING INTENSITIES 
KOUNTS - ARRAY OF INSTRUMENT COUNTS FOR EACH CHANNEL 

COUNTS FOR THETA = 0 AND 180 DEGREES FOR EIGHT 
CHANNELS 

PHI - ARRAY OF INTENSITY OR FLUX RATIOS FOR EACH CHANNEL 
MODE .EQ. 2 

RATIOS OF IPWARD AND DOWNWARD PROPAGATING FLUXES 
MODE NE. 2 

RATIOS OF UPWARD Ah® DOWNWARD PROPAGATING INTENSITIES 
NCH8 - ARRAY OF FILTER POSITIONS FOR EACH SCAN LINE 

SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED 

UALID8 (MODE, LSCAN, NANGS, 10, I IK), AMU, LCNT2, IQUAL) 


noon noon ooo ooonooo 


COMPARE EACH SET OF SCAM DATA FOR CHANNEL 2 AGAINST A 
COSINE FUNCTION AND RETURN THE QUALITY CONTROL CATEGORY 
INTGR8 (NUMSCN, I ELEC, NSCN, K, KK, NANGS, ANGLE, UOLT, 

CALSLP, CAL I NT, GAIN, INTFLX) 

INTEGRATE INTENSITIES 0-90 DEGREES AND 90 - 180 DEGREES 
TO GET DOWflJARO AND UPWARD FLUXES RESPECTIVELY 

SUBROUT 1 1C CAROAT (NODE, NUMSCN, IPASS, ICH, I ELEC, CALSLP, 

1 CAL I NT, I SCAN 1, ISCAN2, NFLT, NPASS, NSC AN, 

2 KSCAN, ITIME, ROLL, INTFLX, KOUNTS, PHI, NCH8) 
CHARACTER+9 CHRPHI <6),BLANK,CPHI 

INTEGER+2 IDATA(3505) 

REALM SLOPE, A INTER 

REALM INTFLX (NUMSCN, I ELEC, 2) 

DIMENSION KOUNTS(NUMSCN, IELEC,2) 

DIMENSION PHI (NUMSCN, IELEC),LC0UNT(435, 8>,U0LT(435,8) 

DIICNSION mGLE(435),THETA(435),AMU(435),LCNT2(435) 

DIMENSION CALSLP(*),CALINT(*), ISCANK*), ISCAN2(*>, IERR(5> 
DIMENSION NSCAN(*),KSCAN(*), ITIHE(*),R0LL(*),NCH8(*) 

EQUIVALENCE ( IDATA( 1 1), SLOPE), ( IDATA( 13), AINTER) 

EQUIVALENCE (LCOUNT< 1,2),LCNT2( 1 )) 

DATA BLANK/' ‘/,IERR/5*0/ 

FACTR = 180. 0/(2** 1 1 ) 

SIGN = 1.0 

PI = ACOS(-I.O) 

DEGRAD = PI/180.0 

WRITE (6, 1000) MODE 

READ (5,1010) ISCANK 1),ISCAN2(1) 

DO 10 I = 1, IPASS 
NSCAN( I ) = 0 
10 CONTINUE 
NTOT * 0 

NSUB * 0 

NSCN * 0 

NPASS = 1 

READ DATA FOR SINGLE SCAN LINE FROM AIRCRAFT TAPE 

15 IF (NSCN .EQ. NUMSCN) GO TO 50 
READ (10, 1020,END=50) I DATA 
LSCAN = IDATA(5) 

CHECK IF SCAN NUMBER IS BEYOND THE END OF THE CURRENT SCAN 
NUMBER RANGE OR IF THERE HAS BEEN A SCAN NUMBER RESET 

20 IF ( ISCAN2(NPASS) .NE. 0) THEN 

IF ((LSCAN GT. ISCAN2(NPASS)) .OR. 

1 (LSCAN LT. KSCAN(NSCN))) THEN 

IF (NPASS GE. IPASS) GO TO 50 

READ (5, 1010,EN0=50) ISCANKNPASS+1 ), ISCAN2(NPASS+1 ) 
tCASS = NPASS + 1 
GO TO 20 
END IF 
END IF 

NOW HANDLE RELATIONSHIP OF SCAN NUMBER TO START OF SCAN 
NUMBER RANGE 


IF < ISCANKNPRSS) .ME. 0> THEM 

IF (LSCRN LT. ISCflNKNPflSS)) GO TO 15 
EMD IF 

MTOT => MTOT + 1 
HFLT = IDATA(IO) 

NANGS = IDATA<20) 

OT = 190.0 / (NfiNGS- 1 ) 

DO 25 I = 1, NfiNGS 

THETR< I ) * <1-1 )*DT - 5.0 
25 CONTINUE 

IF <IDATA<9) .LT. 128) RROLL = IDATA<9) * FRCTR 

IF <IDATA<9) .GE. 128) RROLL = <IDATA<9> - 256) * FRCTR 

IF (NFLT GE. 1139) RROLL * 4.0 * RROLL 
C 

C ELIMINATE OflTfi FOR WHICH TIC ROLL EXCEEDS 5 DEGREES OR THE 

C ZENITH MEASUREMENT OCCURS WITHIN 0.5 DEGREE OF THE START 

C SCAN PULSE 

C FLIGHTS < 1160: -4.5 < ROLL < 5.0 = GOOD ROLL 

C FLIGHTS 1160 ON: -5.0 < TOLL < 4,5 = GOOD ROLL 

C 

IF ((RROLL LT. -4.5) OR. (RROLL GT. 5.0)) THEN 
IF (LSCAN .EQ. ISCAN2(NPASS)) GO TO 15 
GO TO 15 
END IF 
C 

C CHANGE THE SIGN OF THE ROLL FOR THE C0NUAIR-131A AIRCRAFT 

C 

IF (NFLT .GE. 1160) RROLL = -RROLL 

LTIME = I0ATA<4) + 100*IDATA<3) + 10000*IDATA<2> 

IF <( IDATA< 19) GE. 0) .AND. <IDATA<19) .LE. 2)> THEN 
IF < IDATA< 19) .EQ. 0) GAIN = 0.5 
IF < IDATA< 19) .EQ. 1) GAIN = 1.0 
IF < IDATA< 19) EQ. 2) GAIN * 2.0 
ELSE 

IF (LSCAN .EQ. ISCAN2(NPASS)) GO TO 15 
GO TO 15 
ENO IF 

NSCAN(NPASS) = NSCAN(NPASS) + 1 
NSCN = NSCN + 1 

KSCRN(NSCN) = IDATA<5) 

ITIME(NSCN) = LTIME 
NCH8(NSCN) = IDATA(6) + 7 
C 

C CONUERT COUNTS TO UOLTAGE 

C 

DO 35 N = 1, NfiNGS 

I OFF = 23 + 1ELEC*(N- 1 ) 

DO 30 I = 1, 1 ELEC 

INP = I OFF + I 

LCOUNT(NJ) = IDflTA(INP) 

UOLT(N, I ) = <LCOUNT(N, I ) - fl INTER) / SLOPE 

30 CONTINUE 

35 CONTINUE 

C 

C LOCATE PIXELS IN THE ZENIJH AND NADIR DIRECTIONS 

C 

ROLL(NSCN) = ATOLL 

IF (NFLT .LT. 1160) SIGN = -1.0 



EPS1 = 0. t 
EPS2 =0:1 
DO 40 N = 1,NANGS 

RNGLE(N) = (THETA(N) + S I GN*AROLL ) * DEGRflD 
ffllU(N) = COS(ANGLE(N)) 

DIFF = RBS(RMU(N) - 1.0) 

IF (DIFF .LE. EPS1 ) THEN 
EPS1 = DIFF 

10 = N 

END IF 

DIFF = ABS(AMU(N) + 1.0) 

IF (DIFF .LE. EPS2) THEN 
EPS2 = DIFF 

1180 = N 

END IF 
CONTINUE 

QUALITY CONTROL TEST (MODE EQUALS 0 OR 3) 

COMPARE CHAffrEL 2 DATA TO COSINE FUNCTION TO DETERMINE IF 
DATA ARE IN DIFFUSION DOMAIN 

IF ((MO OE .EQ. 0) OR. (MODE .GE. 3)) THEN 

CALL UAL 1 08 (MODE, LSCAN, NANGS, 10, 1180, AMU, LCNT2, 

IQUAL) 

NSUB = NSUB + 1 

IERR(IQUAL+1> = IERR(IQUAL+1) + 1 
IF (IQUAL GT. 0) TIEN 

NSCAN(NPASS) = NSCAN(NPASS) - 1 
NSCN = NSCN - 1 

IF (LSCAN EQ. I SCAN2(NPASS ) ) GO TO 15 
GO TO 15 
END IF 
END IF 

CONUERT UOLTAGE TO INTENSITY OR CALCULATE UPWARD AND 
D0W1UARD FLUXES IF MODE = 2 

DO 45 K = 1 , I ELEC 

IF ((K .EQ. 1) .OR. ((K .GT. 1) .AND. (MODE .GT. 0))) THEN 
KK = K 

IF (K .EQ. I ELEC ) KK = NCH8(NSCN) 

IF ((K EQ. I ELEC ) .AND. (KK EQ. 7)) GO TO 45 
IF (MODE .NE. 2) THEN 

INTFLX(NSCN,K, 1) = (UOLT( IO,K)*CALSLP(KK) + 

CALINT(KK)) / GAIN 

INTFLX(NSCN,K,2) = (UOLT( I 180,K>*CALSLP(KK) + 

CALINT(KK)) / GAIN 

ELSE 

CALL INTGR8 (NUMSCN, I ELEC, NSCN, K, KK, WINGS, 
ANGLE, UOLT, CALSLP, CAL I NT, (MIN, 
INTFLX) 

El® IF 

IF ((MODE EQ. 1) .Ah®. ( I NTFLX(NSCN, K, 1 ) .EQ. 0.0)) THEN 
PHI (NSCN,K) = 10.0 
ELSE 

PHI (NSCN, K) = INTFLX(NSCN,K,2) / INTFLX(NSCN,K, 1 ) 
END IF 

END IF 


KOUNTS(NSCN,K, 1 ) = LCOUNT( 10,10 
K0UNTS(NSCN,K,2) = LC0UNT( I 180,10 
45 CONTINUE 

GO TO 15 
C 

C WRITE OUT SUW1ARY, ERROR SUMMARY, AND PHI TABLES 

C 

50 WRITE (6,1030) NTOT,NUMSCN,NSCN,NPRSS 

IF (ISCANK1) .EQ. 0) ISCANK1) = KSCRN(I) 

IF < ISCRN2(NPASS) .EQ. 0) ISCAN2(NPASS> = LSCRN 
IF (NODE .EQ. 0) THEN 

IF (NFLT .LT. 1160) THEN 
R1 = -4.5 
R2 = 5.0 
ELSE 

R1 = -5.0 
R2 * 4.5 
END IF 

ISCAN2(W»ASS) = LSCRN 
NROLL = NTOT - NSUB 

WRITE (6,1040) (IERR(I ), 1=1, 5), NROLL, R1,R2, NTOT 
END IF 

IF (NODE .GE. 2) THEN 
DO 60 I = 1,NSCN 
DO 55 J = 1,6 

CHRPHI(J) = BLRNK 
55 CONTINUE 

IF (PH 1(1,1 ELEC ) .NE. 0.0) THEN 
WRITE (CPHI , 1050) PH I ( I , I ELEC ) 

ICHN = NCH8( I ) - 7 
CHRPH I ( I CHN ) * CPHI 
END IF 
INI * I - 1 

IF (M0D(IN1,56) EQ. 0) WRITE (6,1060) (K,K=1,ICH) 

WRITE (6,1070) KSCffli( I ), (PHI ( I , J), J=1,7), (CHRPHI (J), J=1,6) 

60 continue 

END IF 
RETURN 

1000 F0RfWT(//,36H THE QUALITV CONTROL CATEGORIES RRE:,//, 

1 5H DATA, /, 17H QUAL DEFINITION, /, 1X,4( 1H-),2X, 10( 1H-), /, 

2 3X, 1H0,3X, 15HACCEPTABLE DATA, /,3X, 1H1,3X, 

3 40HNADIR INTENSITY EXCEEDS ZENITH INTENSITY,/, 

4 3X, 1H2,3X,38HNUMBER OF TINES DEUIATIONS FROH COSINE, 

5 28H CURUE CHANGE SIGN IS .LE. 3,/, 

6 7X,32HF0R XMU BETWEEN 0.9 AND -0.9 AMD, 

7 44H STANDARD_DEU I AT I ON . GT . 0.5*(STDDEU THRESH),/, 

8 3X, 1H3, 3X, 39HSAMPLE STANDARD DEUIATION AROUND COSINE, 

9 35H CURUE EXCEEDS 5* OF NEAN AMPLITUDE,/, 

A 3X, 1H4,3X,35HMAXIMUM DEUIATION FROM COSINE CURUE, 

B 30H EXCEEDS 10* OF NEAN ANPLITUDE, //, 

C 32H THE NODE OF DATA PROCESSING IS ,I1,7H WERE:,//, 

D 55 H 0 = PERFORN QURLITY CONTROL TESTS FOR ALL SCAN LINES, 

E / 48H 1 = PLOT SELECTED CHANNELS FOR ALL SCAN LINES,/, 

F 53H 2 = DERIUE SPECTRAL GROUNO ALBEDO AND PLOT RESULTS,/, 

G 49H 3 = DERIUE SPECTRAL SINILARITY PARAMETER USING, 

H 39H INDIUIDUAL SCAN LlhES AW) PLOT RESULTS) 

1010 F0RMAT(7I10) 

1020 F0RMAT(44(80A2)) 
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1030 FORMRT < 1H 1 , //, 4 1H THE TOTRL NUMBER OF SCRM LIMES RERD IM =,16,/, 

1 52H THE MAXIMUM NUMBER OF SCAN LINES OF URL 10 ORTA THAT, 

2 19H CRN BE PROCESSED -, I6,/,26H THE ACTUAL NUMBER OF SCRM, 

3 32H LINES OF URL ID DATA PROCESSED =, 16,/, 

4 43H THE NUMBER OF SCAN Lift GROUPS PROCESSED =, 13) 

1040 F0Rf1AT<//,49H THE NUMBER OF SCAN LINES IN EACH QUALITY CONTROL, 

1 14H CATEGORY RRE:,//,5H DATA, /, 15H QURL NUMBER , 

2 10HDEFINITI0N,/, 1X,4< 1H-),2X,6< 1H-),2X, 10< 1H-), /,3X, 1H0, 18, 

3 3X, 15HACCEPTABLE DATA,/,3X, 1H1, 18, 3X, 15HNADIR INTENSITY, 

4 25H EXCEEDS ZENITH INTENSITY, /,3X, 1H2, 18, 3X,9HNUMBER OF, 

5 55H TlltS DEUIATIONS FROM COSIft CURUE CHANGE SIGN IS .LE., 

6 2H 3,/, 15X,41HF0R XMU BETUEEN 0.9 AND -0.9 AND STANDARD, 

7 35H DEU I AT I ON GT. 0.5*<ST00EU THRESH), /,3X, 1H3, 18, 3X, 

8 53HSRMPLE STANDARD DEU I AT I ON AROUND COS I ft CURUE EXCEEDS, 

9 21H 5* OF MEAN AMPLITUDE, /,3X, 1H4, I8,3X,7HMAXIMUM, 

A 48H DEU I AT I ON FROM COSINE CURUE EXCEEDS 10* OF MEAN, 

B 10H Afff>LITUDE,/,3X, 1H5, I8,3X, 18HR0LL OUT OF RANGE , 

C 1H<,F4. 1,9H < ROLL <,F3. 1, 1H), /,8X,4< 1H-), /,6H TOTAL, 16) 

1050 FORMAT <F9 . 5 ) — 

1060 F0RMAT(1H1,/,6H SCAN, 13(2X,4HPHI (, 12, 1H)),/, 1X,5<1H-), 

1 13<2X,7< 1H-)>) 

1070 FORMAT < 1 6, 7F9 . 5, 6A9 ) 

END 

SUBROUTINE URLID8 
PURPOSE 

COWARE EACH SET OF SCAN DATA FOR CHANNEL 2 AGAINST A COSINE 
FUNCTION ATO RETURN QUALITY CONTROL CATEGORY 

USAGE 

CALL UAL 1 08 <MOOE, LSCAN, NANGS, 10, 1180, AMU, LCNT2, I QURL) 

DESCRIPTION OF PARAMETERS 

MODE - MODE OF DATA PROCESSING 

0 PERFORM QUALITY CONTROL TESTS FOR ALL SCAN LINES 

1 CREATE PLOTS FOR ALL SOW LINES AT® SELECTED CHANNELS 

2 DERIUE SPECTRAL GROUND ALBEDO 

3 DERIUE SPECTRAL SIMILARITY PARAMETER USING INDIUIDUfiL 
SCAN LlftS 

LSCAN - SCAN LINE NUMBER 
NANGS - NUMBER OF PIXELS IN ACTIUE SCAN 
10 - INDEX OF ZENITH PIXEL 

I 180 - INDEX OF NADIR PIXEL 

AMU - ARRAY OF THE COSINES OF THE SCAN ANGLES 
LCNT2 - ARRAY OF TIC SCRN COUNTS FOR CHANNEL 2 
IQUAL - QUALITY CONTROL CATEGORIES 

0 ACCEPTABLE DATA 

1 NADIR INTENSITY EXCEEDS ZENITH INTENSITY 

2 NUMBER OF TIMES DEUIATIONS FROM COSINE CURUE CHANGE 
SIGN IS .LE. 3, FOR XMU BETUEEN 0.9 AND -0.9 AND 
STANDARD DEU I AT I ON .GT. 0.5*(STDDEU THRESH) 

3 SAMPLE STANDARD DEU I AT I ON AROUND COS I It CURUE 
EXCEEDS 5* OF MEAN AMPLITUDE 

4 MAXIMUM DEU I AT I ON FROM COSINE CURUE EXCEEDS 10* OF 
MEAN AMPLITUDE 

SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED 
NONE 
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SUBROUTINE URLID8 (MODE, LSCflN, NRNGS, 10, 1180, RHU, LCNT2, 

1 IQURL) 

DIMENSION RMU<* ), LCNT2<* > 

DflTfl NPRSS/0/ 

IQURL = 0 
NPfiSS = NPRSS + 1 

FIND THE CHARACTERISTICS OF TIC COSINE FUNCTION THROUGH TIC 
ZENITH/NROIR ENDPOINTS 

NPTS =1180-10+1 

NPTSM2 = NPTS - 2 

LCNTNX = LCNT2< 10) + LCNT2O0+1) 

RMUfIX = RNU<IO) + RNU< 10+1 ) 

IDIU = 2 

IF <10 .GT. 1) THEN 

LCNTNX = LCNTNX + LCNT2<I0-1> 

RMUHX = RHUHX +RHU<I0-1) 

IDIU * 3 

END IF 

LCNTNX = LCNTNX / IDIU 
RMUHX = RNUNX / IDIU 
LCNTNN = LCNT2< I 180) + LCNT2C 1 180-1 ) 

RNUNN = RNU<I 180) + RNU<I 180-1) 

IDIU = 2 

IF <1180 .LT. NRNGS) THEN 

LCNTNN = LCNTNN + LCNT2<I 180+1) 

RNUNN = RttJMN + RMU< 1 180+1 ) 

IDIU > 3 

END IF 

LCNTNN = LCNTNN / IDIU 
RNUNN = RNUNN / IDIU 

COSSLP = < LCNTNX - LCNTNN )/< RNUNX - RNUNN) 

RNPLMN ■ < LCNTNX + LCNTNN)/2.0 

COMPARE THE DEUIRTION STATISTICS OF THE DflTfl FROM TIC C0SI1C 
FUNCTION UITH THE QUALITY CONTROL TESTS 


SDEUMX = 0.05 * RNPLMN 

DEUMRX = 0.0 

DEUNIN = 0.0 

SUN = 0.0 

SUM2 = 0.0 

NCHNGE = 0 

IF <COSSLP .LE. 0.0) IQURL = 1 
DO 10 I = 1 , NPTSM2 

DEUI8 = LCNT2< 1 0+1 ) - LCNTNN - 
1 C0SSLP*<RMU<I0+I) - RNUNN) 

IF <DEUI8 .GT. DEUmX) DEUMRX = DEUI8 
IF <DEUI8 LT. DEUMIN) DEUNIN = DEUI8 
IF <1 .GT. 1) THEN 

IF <<RMU< 10+1 ) LE. 0.9) .AND. 

1 <RNU< 10+1 ) GE. -0.9)) THEN 

IF <DEUI8*0£U8M1 .LT, 0.0) NCHNGE = NCHNGE + 1 
END IF 
ETC IF 

SUM = SUN + 0EUI8 
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SUM2 * SUM2 + DEV I 8*DEU I 8 
0EV8M1 = DEV I 8 
10 CONTINUE 

ARTHMN = SUM / NPTSN2 
STNDEU = SQRT<SUH2 / NPTSN2) 

IF <STN0EU GT. 0.5*SDEVMX) THEN 
IF (NCHNGE LE. 3) THEN 

IF < IQUFIL .EQ. 0) IQUfiL = 2 
END IF 
END IF 

IF (STNDEU .GT. SDEVMX) THEN 
IF < IQUfiL .EQ. 0) IQUfiL = 3 
END IF 

IF ((DEVMRX .GT. 2.0*SDEVMX> OR. 

1 (DEVMIN .LT. -2 . 0*S0EUHX ) ) THEN 
IF < IQUfiL .EQ. 0) IQUfiL = 4 
END IF 

WRITE OUT RESULTS 
IF (NODE NE 0) GO TO 999 

IF ((NPfiSS .EQ. 1) OR. <H0D<NPfiSS,52> .EQ. 0)) WRITE (6,1000) 
WRITE (6,1010) NPASS,LSCAN, I 0,1 180, COSSLP,SOEUMX,DEUMAX, DEVMIN, 

1 fBVTHMN , NCHNGE , STNDEU , I QUfiL 

999 RETURN 

1000 FORNflTdHI,//, 

1 29X, 19HZENITH / NflDIR CflSE,/, 18X,5HPIXEL,/, 

2 9X, 4HSCRN, 5X,5HI NDEX, 14X, 6HSTDDEV, 10X, 9HDEV I AT I ON, 

3 14X,6HSfiNPLE,2X,4HDflTfi, /,2( 1X,6H"ftJ1©ER>, 

4 10H ZEN Nfl0,4X,5HSL0PE,4X,6HTHRESH,6X,3HHRX,5X, 

5 3HN I N, 4X, 4HMEAN, 2X, 3H+/-, 3X, 6HSTDDEV, 2X, 4HQURL, /, 

6 2( IX, 6( 1H-)),3X,7( 1H-),4X,5( 1H-),4X,6( 1H-),4X,21( 1H-), 

7 2X,3( 1H-),3X,6( 1H-),2X,4( 1H-), /) 

1010 F0RNfiT( 16,217, 14, F9. 1,F10.2,F9. 1,2F8. 1, I5,F9.2, 15) 

END 

SUBROUTINE INTGR8 
PURPOSE 

INTEGRATE INTENSITIES TO GET UPWARD AND DOWNWARD PROPAGATING 
FLUXES AND STORE IN INTFLX(NSCN, I ELEC, 2) AND 
INTFLX(NSCN, IELEC, 1 ) RESPECTIVELV 

USAGE 

CALL INTGR8 (NUNSCN, IELEC, NSCN, K, KK, NANGS, ANGLE, 

VOLT, CfiLSLP, CAL I NT, GAIN, INTFLX) 

DESCRIPTION OF PARAfETERS 

NUNSCN - D I HENS I ON SPECIFYING THE NAXINUN NUNBER OF SCAN LINES 
THRT CRH BE PROCESSED 

IELEC - D I MENS I ON SPECIFYING THE MAXIMUM NUNBER OF ELECTRICAL 
CHANNELS 

NSCN - CURRENT SCAN INDEX 

K - ELECTRICAL CHANNEL INDEX 

KK - SPECTRAL CHANNEL INDEX 

NANGS - NUMBER OF PIXELS (ANGLES) IN THE ACTIVE SCAN 
ANGLE - ARRAY OF THE PIXEL SCAN ANGLES (RADIANS) 

VOLT - ARRAY OF THE VOLTAGES FOR EACH PIXEL 

CfiLSLP - ARRAY OF CALIBRATION SLOPES IN MW j ( CM**2*M I CRON*SR*U ) 


c 

c 

c 

c 

c 

c 

c 
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c 
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CALINT - ARRRY OF CALIBRATION INTERCEPTS IN HU/(Cn**2*M I CRON+SR ) 
GAIN - GAIN USED IN CALCULATING THE INTENSITY 
INTFLX - ARRAY OF INTENSITIES OR FLUXES FOR EACH CHANNEL 
NODE .EQ. 2 

UPWARD AND DOUNUARD PROPAGATING FLUXES 
NODE .NE. 2 

UPWARD AND DOWNWARD PROPAGATING INTENSITIES 

SUBROUTINES AM) FUNCTION SUBPROGRAMS REQUIRED 
NONE 

SUBROUTINE INTGR8 (NUMSCN, I ELEC, NSCN, K, KK, NANGS, ANGLE, 

1 UOLT, CALSLP, CAL I NT, GAIN, INTFLX) 

REAL*4 INTFLX<NUHSCN, I ELEC, 2), INTEN<435) 

DIMENSION UOLT <435, 8) 

DIMENSION ANGLE<435),ANU2<435> 

DIVISION CALSLP<*),CALINT<*> 

PI = ACOS(-I.O) 

DO 10 I - 1, NANGS 

INTENd ) = (UCB.T ( I , K >*CALSLP(KK ) + CAL I NT (KK ) ) / GAIN 
INTEN(I) = (UOLT ( I , K >*CALSLP(KK ) + CALINT(KK)) / GAIN 
10 CONTINUE 

FIND INDEX FOR ANGLE CLOSEST TO, BUT .GE., 0 RADIANS (10) 

FIND INDEX FOR ANGLE CLOSEST TO, BUT .(X., PI/2 RADIANS (190) 

FIND INDEX FOR ANGLE CLOSEST TO, BUT LE. , PI RADIANS (1180) 

DO ONLY FOR FIRST PASS FOR THIS SCAN (IE. CHANNEL 1) 

IF <K EQ. 1) THEN 
10 =0 

190 =0 

1180 =0 

ANG = 0.0 
ANGO = 0.0 
ANG90 = 0.0 
ANG 180 = 0.0 
DO 20 I * 1, NANGS 

ANU2< I ) = SIN(2.0*RNGLE( I )) 

IF < ANGLE ( I ) .GE. ANG) THEN 
IF <10 EQ. 0) THEN 
ANGO = ANGLE ( I ) 

10 = I 

ELSE 

IF (190 .EQ. 0) THEN 
ANG 90 = ANGLE < I ) 

190 = I 
ELSE 

ANG 180 = ANGLE < I ) 

1180 * I 
END IF 

END IF 

ANG = ANG + PI/2.0 
END IF 

20 CONTINUE 

END IF 

INTEGRATE INTENSITIES BY TRAPEZOIDAL RULE 
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OELANG = < ANGLE (NRNGS) - ANGLE < 1 ) ) / (NRNGS - 1) 

I90M =190-1 

IF (ANG90 .EQ. PI/2.0) I90H = 190 

FLXTRM = < I NTEM< 1 0 )*ANU2( 1 0 ) + I NTEN( 1 90M )*RNU2( 1 9CH1 ) ) / 2.0 
DO 30 I = 10+1, I90H-1 

FLXTRN = FLXTRM + INTEN< I >*RNU2( I ) 

30 CONTINUE 

FLXREF = (INTEN(I90)*ANU2(I90) + I NTEN( 1 180 )*ANU2( 1 180 ) ) / 2.0 
DO 40 I = 190+1, 1 180-1 

FLXREF = FLXREF + INTEN< I )*ANU2( I ) 

40 CONTI HUE 

FLXTRN = FLXTRN * PI * DELANG 
FLXREF = FLXREF * PI * DELfiNG 

ROD (Ml EXTRAPOLATED END POINTS 

DELRO = RNGO 

DELR90 = <PI / 2.0> - ANGLE< I90M) 

FLXTRN = FLXTFM1 + ( I NTEN< 1 0 )*RNU2( 1 0 >*DELRO + 

1 I NTEN< 1 90M )*AfflJ2( 1 90f1 )*0ELR90 ) * PI / 2.0 

DELR90 = RNG90 - <PI / 2.0) 

DEL 180 = PI - RNG180 

FLXREF = FLXREF + < I NTENC 1 90 >*ANU2< 1 90 )*DELA90 + 

1 I NTEN< I 180 )*RNU2( I 180 )*DEL 180 > * PI / 2.0 

FLXREF = - FLXREF " ^ 

INTFLX(NSCN,K, 1 ) = FLXTRN 
INTFLX<NSCN,K,2) = FLXREF 
999 RETURN 
END 

SUBROUTINE STOEU 
PURPOSE 

FIND HERN AND STANDARD DEU I AT I ON OF X ARRAV 
USAGE 

SUBROUTINE STDEU (X, NX, XBAR, SIGX) 

DESCRIPTION OF PARAMETERS 

X - ARRAV FOR UHICH THE MEAN AND STANDARD DEU I AT I ON ARE TO BE 
FOUND % • * • 

NX - NUMBER OF ELEMENTS IN X ARRAV 
XBAR - ARITHMETIC MEAN OF X ARRAV 
SIGX - STANDARD DEU I AT I ON OF X RRRAV 

SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED 
NOTE 

SUBROUTINE STDEU <X, NX, XBAR, SIGX) 

DIMENSION X<*> 

SUMX = 0.0 
SUMX2 = 0.0 
DO 10 N = 1,NX 

SUMX = SUMX + X(N) 

SUMX2 = SUMX2 + X(N)*X(N> 

10 CONTINUE 

XBAR = SUMX / NX 

SIGX = SUMX2 - NX*XBAR*XBAR 

IF (SIGX .LT. 0.0) SIGX = 0.0 


3 1 OX * SQRT<SIGX / <NX - 1.0>> 

RETURN 

END 

C SUBROUT I NE FINDS 
C 

C PURPOSE 

C INTERPOLATE S RND PHI RRRRYS USING SPLINE UNDER TENSION 

C 

C USAGE 

C SUBROUTINE FINDS (TSTRR, PHIBRR, RG, SUAL) 

C 

C DESCRIPTION OF PARAMETERS 

c TST RR - <1 - G)*<TAUC - TRU) FROM CONSERUATUE CHANNEL <1 OR 2) 

C PHIBRR - MEAN UALUE OF l<-1> / K1) 

C AG GROUND ALBEDO 

C SUAL - SIMILARITY PARAMETER 

C 

C SUBROUTINES AND FUNCTION SUBPROGRAMS REQU I RED 

C QPHI <S, RG, T) 

C DETERMINES PHI AS R FUNCTION OF S FOR FIXED UALUES OF AG 

C AND T 

C SPLINT <N, X, F, 14, IOP, COSECH, A, B, SIGMA, V) 

C DETERMINES THE PARAMETERS NECESSARY TO COMPUTE AN I NTERPOLA- 

C TORY SPLINE UNDER TENSION THROUGH A SEQUENCE OF FUNCTIONAL 

C UfiLUES 

C INTERT <N, X, F, 14, COSECH, SIGMA, XBAR, TAB) 

C INTERPOLATES A CURUE AT A GIUEN POINT USING A SPLINE UNDER 

C TENSION 

C 

SUBROUTINE FINDS < TSTRR, PHIBRR, RG, SUAL) 

DIMENSION F< 103), X< 103), Y( 103), H< 103), A< 104), B< 103),C0SECH< 103) 
DIMENSION I0P<2),TAB<3) 

DATA IOP/2*5/ 

SIGMA = 1.0 
C 

C COMPUTE SIMILARITY PARAMETER AS fl FUNCTION OF PHI 

C 

NS = 100 
DELS = 1.0 / NS 
DO 10 I = 2, NS 

F<NS+ 1- I ) = <1-1 )*DELS 

X(NS+1-I) = QPHKF<NS+1-I ), AG, TSTRR) 

10 CONTINUE 
DO 15 I = 1,4 

F<NS+4-l ) = < I - 1 )*0 . 00 1 

X<NS+4-l) = QPHI <F(NS+4-l >, AG,TSTW) 

15 CONTINUE 
NS = NS + 3 

CALL SPLINT <NS, X, F, U, IOP, COSECH, A, B, SIGMA, Y) 

CALL INTERT <NS, X, F, U, COSECH, SIGMA, PHIBRR, TAB) 

SUAL = TAB< 1 ) 

RETURN 

END 

C FUNCTION QPHI 

C 

C PURPOSE 

C DETERMINES PHI AS A FUNCTION OF S FOR FIXED UALUES OF AG 

C AND T 
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USfttjE 

FUNCTION QPHI <S, AG, T) 

DESCRIPTION OF PARAMETERS 
S - SIMILARITY PARAMETER 
AG - GROUND ALBEDO 
T - <1 - G) * CTAUC - TRU) 

SUBROUTINES AND FUNCTION a®PROGRAMS REQUIRED 
NOTE 

FUNCTION QPHI <S, AG, T) 

QP = 0.714 

IF <S .GT. 0.0) GO TO 10 

CONSERUATIUE SCATTERING 

ANUM ■ 3.0 * <1.0 - AG) * <T + QP - 1.0) + 4.0* AG 
ADEN = 3.0 * <1.0 - AG) * <T + QP + 1.0) + 4.0*AG 
QPHI - ANUM / ADEN 
GO TO 20 

NONCONSERUATIUE SCATTERING 

10 SMI * 1.0 - S 

TUOT - 2.0 * T 

ASTRR = <1.0 - 0. 14638*S) * SMI / <1.0 + 1.1629*S) 

0 * <1.0 - 0 . 98742*S ) * SMI / <1.0 + 1 4767+S) 

RL = <1.0 - 0.68128*S) * SMI / <1.0 + 0.79192*S) 

AN2 = <1.0 + 0.41416*S) * SMI / <1.0 + 1.8877*S) 

BM ■ <1.0 + 1.8*S - 7 . 087*S*S + 4.74*S*S*S)/ 

1 <<1.0 - 0.819*S) * ail * SMI) 
AM = <1.0 + 1.537*S) * AL0G<BM) 

AMI = 1.0 - AG+ASTAR 

21 = <1.0 + 2 . 0785*S ) * SMI / <1.0 + 2.8162*S) 

P * 1.0 + 0 . 44257*S 

Z1 = Z1**P 

Z = 21**TU0T 

WflJM = AMI * <D - AL*Z) + AG*AM*AN2*Z 
ADEN = AMI * <1.0 - D*AL*Z) + AG*AM*AN2*D*Z 
QPHI = ANUM / AOEN 
20 RETURN 
END 

SUBROUTINE SPLINT 
PURPOSE 

DETERMINES THE PARAMETERS NECESSARY TO COMPUTE AN I NTERPOLATORV 
SPLINE UNDER TENSION THROUGH A SEQUENCE OF FUNCTIONAL UALUES 

USAGE 

CALL SPLINT <N, X, F, U, IOP, COSECH, A, B, SIGMA, Y) 

DESCRIPTION OF PARAMETERS 
N - NUMBER OF POINTS IN X AND F ARRAYS 

X - ARRAY CONTAINING INDEPENDENT UAR I ABLE 

F - ARRAY CONTAINING DEPENDENT UAR I ABLE 

U - ARRAY OF 2N0 OERIUATIUE UALUES 
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I OP - ARRAY WHICH DEFINES BOUNDflRV CONDITIONS TO BE USED 

1 2ND DERlUflTIUE 

2 RUN OUT AT BOUNDflRV 

3 1ST DERlUflTIUE 

4 PERIODIC 

5 1ST DERlUflTIUE CALCULATED FROM 4 POINT INTERPOLATION 
COSECH - HYPERBOLIC FUNCTION ARRAY 

COSECHd) = 1. / SINHCSIG * <X<I) - X< 1-1 >>> 

A - RRRflV CONTAINING OFF-D I AGONAL ELEMENTS 
B - RRRflV CONTAINING DIAGONAL ELEMENTS 
SIGMA - NORMALIZED TENSION PARAMETER 

V - ARRAY CONTAINING RIGHT HAND SIDE OF TRID I AGONAL SYSTEM 

SUBROUTINES WO FUNCTION SUBPROGRAMS REQUIRED 
TRIDIP (N fl B C V U) 

INUERTS TR I 01 AGONAL MATRIX IN ORDER TO SOLUE THE SYSTEM OF 
LINEAR EQUATIONS GIUING THE 2ND DERlUflTIUE UALUES 

COMMENTS 

X, F, U, COSECH, B, Y ARRAYS MUST BE DIMENSIONED GE. N 
A ARRAY MUST BE DIMENSIONED .GE. N+1 

IF IOP(1) < 4, U(1) MUST CONTAIN SPECIFIED BOUNDARY CONDITION 

IF I0P(2) < 4, U(N) MUST CONTAIN SPECIFIED BOUNDARY CONDITION 

SUBROUTINE SPLINT (N, X, F, U, I OP, COSECH, A, B, SIGMA, Y) 
DIMENSION X(N),F(N),U(N), I0P(2),C0SECH(N),A(N>,B<N),Y(N> 

DENORMALIZE TENSION FACTOR 

SIG = SIGMA * FLOAT(N-I) / (X(N) - X<1)) 

SIG2 = SIG * SIG 

SIG2R = 1.0 / SIG2 

SIGR = 1.0/ SIG 
UN = U<N) 

DO 5 I = 2,N 

SIGH = SIG*(X(I )-X<l-1>) 

SIGHR = 1.0/SIGH 
EXPX = EXP(SIGH) 

COSECH< I ) = 2.0 / (EXPX - 1.0/EXPX) 
fl(l ) = SIGHR - COSECHd > 

B< I ) = SORT (1.0 + COSECHd )**2) - SIGHR 
Yd) = (Fd) - Fd-1» * SIGWI 
5 CONTINUE 
NN = N 


SELECT BOUNDARY CONDITION APPROPRIATE TO BOUNDARY 1 
MK = I0P(1) 

GO TO (10,15,20,25,30), fK 
10 U(1) = U(1) * SIG2R 

V(2) = Y(3) - Y(2) - A(2)*U( 1 ) 

fl( 2 ) = 0.0 

B(2) = B(2) + B(3) 

II =2 
NN = NN - 1 
GO TO 35 

15 Y(2) = Y(3) - V(2) 

B(2) = B(2) +B(3) + U( 1 )*fl(2) 
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fl < 2 ) = 0.0 
11 =2 
NH = NN - 1 
GO TO 35 

20 VC 1 > = VC2) - U( 1 >*SIGR 
YC2) = YC3) - V<2) 

RC1) = 0.0 
BC 1 ) = BC2) 

B<2> = BC2) + B<3> 

II = 1 
GO TO 35 

25 V2 = V<2) 

B2 = B<2) 

V<2> = YC3) - V<2) 

BC2) = BC2) + B<3) 

1 1 =2 
NH = NN - 1 
GO TO 35 

30 fll = XC1) - XC2) 

R2 = XC1) - X<3) 

R3 = X<1) - X<4) 

R4 = X<2) - X<3) 

R5 = XC2) - XC4) 

R6 = X<3) - X<4> 

kl< 1 > = F< 1 ) * < 1 ,0/fll + 1.0/R2 + 1.0/R3) 

1 - R2*fl3*F<2> / (R1*R4*R5) + R1*R3*F<3) / <R2*R4*fl6) 

2 - R1*fl2*F<4> / (R3*R5*R6) 

GO TO 20 

COMPUTE B V RRRRVS 

35 12 = N - 2 
00 40 I =3,12 

V<l> = VC 1+1 > - V<l> 

B< I ) = BC 1 > + BC 1+1 ) 

40 CONTINUE 

SELECT BOUNDARY CONDITION APPROPRIATE TO BOUNDARY 2 
ML = I0P<2) 

GO TO <45,50,55,60,65), ML 

45 UN = UN * SIG2R 

Y<N- 1 ) = Y<N> - Y<N-1 ) - fl<N)*MN 

fl<N) = 0.0 

B<N- 1 ) = B<N-1 ) + B<N> 

NN = NN - 1 
GO TO 70 

50 Y<N-1 ) = Y<N> - Y(N-1 ) 

B<N- 1 ) = BCN-1 ) + B<N) + WN*fl<N) 
fl<N) = 0.0 
NN = NN - 1 
GO TO 70 

55 V<N-1) = V(N> - Y(N- 1 ) 

Y<H) = -Y<N) + lfli*SIGR 
BCN-1 ) = BCN-1) + BCN) 

RCN+1 ) = 0.0 
GO TO 70 

60 YCN-1 ) = VCN) - VCN-1 ) 



oooooooooooooooooo 


Y<H> * Y2 - Y <N> 

B<N-1) = B<N-1) + B<N) 

B<N) - B<N) + B2 
A<N+1) = A<2) 

GO TO 70 

65 B1 = X<N) - X<N-3) 

B2 = X<N> - XCH-2) 

B3 = X<N) - X<N-1) 

B4 = X<N- 1 ) - X<H-3) 

B5 = X<H-1> - X<N-2) 

B6 = X<N-2) - X<N-3> 

UM = - B2*B3*F<N-3) / <B6*B4*B1) + B1*B3*F<N-2) / <B6*B5*B2) 

1 - B1*B2*F<N-1> / <B4*B5*B3) 

2 + F<N) * < 1.0/BI + 1.0/B2 + 1.0/B3) 

GO TO 55 

70 CflLL TRIDIP <Wi, BUI), RCII+I), V<I1), W<I1» 

GO TO <85,75,85,80,85), ft< 

75 I4< 1 > * U< 1 ) * U<2) 

GO TO 85 
80 U<1> = U<N) 

85 GO TO <90,95,999,999,999), ML 
90 U<N) = I4M 
GO TO 999 

95 U<N) = IKH-1) * UN 
999 RETURN 
END 

SUBROUTINE TRIDIP 
PURPOSE 

INVERTS R TR I D I RGONfiL MATRIX IN ORDER TO SOLVE THE SYSTEM OF 
LllCfW EQUATIONS GIVING Tf£ SECOND DERIVATIVES FOR A SPLINE 
UNDER TENSION 

USAGE 

CALL TRIDIP <N, A, B, C, Y, U) 

DESCRIPTION OF PARAMETERS 

N - DIMENSION OF TRIDIAGONAL MATRIX 
A - ARRAY CONTAINING OFF-O I AGONAL ELEMENTS 

B - ARRAY CONTAINING DIAGONAL ELEMENTS 

C - ARRAY CONTAINING OFF-D I AGONAL ELEMENTS 

Y - ARRAY CONTAINING RIGHT HAND SIDE OF TRIDIAGONAL SYSTEM 

U - ARRAY OF 2ND DERIVATIVE VALUES COMPUTED 

SUBROUTINE TRIDIP <N, A, B, C, Y, U) 

DIMENSION A<N),B<N),C<N),Y<N),U<N),D<201),Z<201),U<201) 

AN = A<N) 

VN = V<N) 

NM3 « N - 3 

D< 1 ) = C< 1 ) / B< 1 ) 

Z<1) = Y< 1 ) / B< 1 ) 

V = C<N) 

U<1) = A< 1 > / B< 1 > 

DO 5 J = 2,NM3 

DEN = B<J) - R<J)*D<J-1 ) 

D<J) = C<J) / DEN 

U<J) = -A<J) * U<J-1) / DEN 

Z<J) = <V<J) - A<J)*Z<J-1 )) / DEN 
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AM = AN - U*U<J) 

YN = YN - U*Z<J) 

U - -U * D<J> 

5 CONTINUE 

DEN = B<N-2) - A<N-2 >*D<N-3) 

D<N-2) = <C<N-2) - A<N-2)*U<N-3>> / DEN 
Z<N-2) = <Y<N-2) - A<N-2)*Z<N-3>) / DEN 
AN = AN - U*0<N-2) 

VN = VN - U*Z<N-2> 

DEN = BCN-1) - A<N-1 >*0(N-2) 

D(N-1 > = C<N-1) / DEN 
Z(N-1) = (VCN-1) - Z<N~2 )*A<N-1 )) / DEN 
U<N> = <YN - AN*Z<N-1)) / <B<N) - AN*D<N-1)) 

U<N-1) = Z<N-1 ) - D<N-1 )*U<N) 

W<N-2) = Z<N-2> - D<N-2)*U<N-1 ) 

NM = N - 1 
DO 10 J = 3,NM 
K = N - J 

U(K) = Z<K) - D<IO * UCK+1 > - U<K)*I4<N-1) 

10 CONTINUE 
RETURN 
END 

SUBROUTINE INTERT 
PURPOSE 

INTERPOLATES A CURUE AT A GIUEN POINT USING A SPLINE UNDER 
TENSION 

USAGE 

CALL INTERT <N, X, F, W, COSECH, SIGMA, XBAR, TAB) 

DESCRIPTION OF PARAMETERS 

N - NUMBER OF POINTS IN F AND X ARRAYS 

X - ARRAY CONTAINING INDEPENDENT VARIABLE 

F - ARRAY CONTAINING DEPENDENT UARIABLE 

14 - ARRAY OF 2ND DERIUATIUE UALUES CALCULATED BY SPLINT 

COSECH - HYPERBOLIC FUNCTION ARRAY COMPUTED BY SPLINT: 

COSECH < I ) = 1. / SINH(SIG * <X<I> - X<l-1))) 

SIGMA - NORMALIZED TENSION PARAMETER USED BY SPLINT 
XBAR - POINT AT UHICH INTERPOLATION IS REQUIRED 

TAB - ARRAY OF DIMENSION 3 CONTAINING THE RETURNED FUNCTION, 

1ST DERIUATIUE, AND 2ND DERIUATIUE 

SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED 
SEARCH (XBAR X H I ) 

LOCATES SPLINE UNDER TENSION SEGMENT CONTAINING XBAR 
COMMENTS 

X, F, U, COSECH ARRAYS MUST BE DIIENSIONED .GE. N 

SUBROUTINE INTERT <N, X, F, 14, COSECH, SIGMA, XBAR, TAB) 
DIMENSION X<N),F<N),U<N),C0SECH(N),TAB<3) 

DENORMAL I ZE TENSION FACTOR 

SIG = SIGMA*FL0AT<N-1 )/(X(N) - X(1)> 

C 

C LOCATE XBAR IN TABLE. IF XBAR IS OUTSIDE RANGE OF TABLE, 


C EXTRAPOLATION TAKES PLACE. 

C 

IFOBAR - X<1>> 10, 10, 15 
10 I = 1 
GO TO 30 

15 IFOBAR - X(N>) 25,20,20 
20 I = N - 1 
GO TO 30 

25 CALL SEARCH <XBAR, X, N, I > 

30 FLK ■ X< 1+1 > - X< I ) 

RFLK = 1.0 / FLK 
C 

C CALCULATE F<XBAR> 

C 

XI = XBAR - X<l ) 

XIP1 = X<l+1> - XBAR 
EXPX = EXP(SIG*XI ) 

EXPXP1 = EXP<SIG*XIP1 ) 

SINH * 0.5 * (EXPX - 1.0/EXPX) 

COSH = -SINH + EXPX 

Sl»f>1 * 0.5 * (EXPXP1 - 1.0/EXPXP1) 

C0SHP1 = -SINHP1 + EXPXP1 

A » <U<I)*SINHP1 + W<I+1>*SINH) * C0SECH<I+1> 

B = <F< 1+1 > - W<I+1>)*XI + <F<I ) - W<l »*XIP1 

TAB(1) ■ A + B*RFLK 
C 

C CALCULATE 2ND DERIUATIUE AT XBAR 

C 

TAB<3) * A * SIG**2 
C 

C CALCULATE 1ST DERIUATIUE AT XBAR 

C 

A = SIG*OKI+1> * C0SH-W<I)*C0SHP1> * C0SECH<I+1> 

B = <F< 1 + 1 ) - U< 1 + 1 ) - F< I ) + I4< I )) * RFLK 

TAB<2) = A + B 

RETURN 

END 

C SUBROUTINE SEARCH 

C 

C PURPOSE 

C LOCATE POSITION IN TABLE OF POINT AT WHICH INTERPOLATION IS 

C REQUIRED 

C 

C USAGE 

C CALL SEARCH <XBAR, X, N, I) 

C 

C DESCRIPTION OF PARAMETERS 

C XBAR - POINT AT WHICH INTERPOLATION IS REQUIRED 

C X ARRAV CONTAINING I NDEPENDENT UARIABLE 

C N - NUMBER OF POINTS IN X ARRRV 

C I - INDEX SPECIFYING SEGMENT CONTAINING XBAR 

C 

SUBROUTINE SEARCH (XBAR, X, N, I) 

DIMENSION X(N>,C0M1<6>,C0M2<6> 

DATA B/. 693 147 18/ 

IF <N .LT. 2) GO TO 20 
IF <X(1) .GT. X(2>) GO TO 25 
M = I NT<ALW3<FL0AT<N >) / B) 
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i = 2**n 

K = I 

10 K - K / 2 

IF <(XBAR .GE. X( I )) .WO. (XBAR .LT. XC 1 + 1 >>> RETURN 
IF (XBAR .GT. X(l )) GO TO 15 
I = I - K 
GO TO 10 
15 I = I + K 

IF (I .LE. N) GO TO 10 
I = N 
GO TO 10 

20 WRITE <6, 1000) 

RETURN 

25 WRITE (6, 1010) 

RETURN 

1000 FORMAT (28H SEARCH N IS LESS THAN 2.0) 

1010 FORMAT <42H SEARCH TABLE IS NOT IN INCREASING ORDER) 

END 

SUBROUTINE SEZMXY 
PURPOSE 

MAKE AN X-V PLOT MIXING QMS AND SYMBOLS, OR JUST SYMBOLS 
ALONE, OR JUST CURUES ALONE, USING NCAA AUTOGRAPH ROUTINES 

USAGE 

CALL SEZMXY (LABG, LABX, LABV, X, Y, NPTS, MANY, IDXV, LTYP, 
LROW, LBAC, NPAT, SYMBOL, XMIN, XMAX, YMIN, 

YMAX) 

DESCRIPTION OF PARAMETERS 

LABG - GRAPH LABEL (CHARACTER UARIABLE, .LE. 60 CHARACTERS, 
ENDING IN $ IF .LT. 60) 

LABX - X-AXIS LABEL (CHARACTER UARIABLE LIKE -LABG- ) 

LABV - Y-AXIS LABEL (LIKE -LABX-) 

X - X-COORO I NATES OF POINTS TO BE PLOTTED (DOUBLE PREC. ) 

1-0 ARRAY FOR ALL CURUES IF LROW = f, OF DIMENSION AT 
LEAST 

MAX ( NPTS(K) ) 

K=1, . . . ,MRNY 

OTHERWISE 2-D ARRAY WITH 1ST DIMENSION -IDXY-, 2ND 
DlMENSrON AT LEAST -MANY- (1ST DIMENSION IS POINT 
NUMBER, 21® IS CURUE NUMBER). 

V - Y-COORDINATES OF POINTS TO BE PLOTTED (DOUBLE PREC. ) 
1-0 ARRAY IF MANY = 1, OF DIMENSION AT LEAST 

MAX ( NPTS(K) ) 

K= 1 , . . ,,MANY 

OTHERWISE 2-D ARRAY WITH 1ST DIMENSION -IDXY-, 2ND 
DIMENSION AT LEAST -MANY- (1ST DIMENSION IS POINT 
NUMBER, 2ND IS CURUE NUMBER). 

NPTS - ARRAY CONTAINING NUMBER OF POINTS TO BE PLOTTED FOR 

EACH CURUE; E.G. -NPTS(K)- IS THE NUMBER OF POINTS IN 
CURUE -K- 

MANY - NUMBER OF CURUES TO BE PLOTTED 
IDXV - 1ST DIMENSION OF -V- (AND, IF LROW = 2, OF -X-) 



LTYP - SPECIFIES TYPE OF PLOT 

1 LINEAR X-AXIS, LINEAR Y-AXIS 

2 LINEAR X-AXIS, LOG Y-AXIS 

3 LOG X-AXIS, LI NEW! Y-AXIS 

4 LOG X-AXIS, LOG Y-AXIS 
LROU - SPECIFIES DIMENSION OF X ARRAY 

1 -X- IS SINGLY DIMENSIONED (ALL CURVES HAVE SAME 

2 -X- IS DOUBLY DIMENSIONED (EACH CURVE HRS ITS OWN 

) 

LBAC - SPECIFIES BACKGROUND OF GRAPH 

1 PERIMETER BACKGROUND 

2 GRID BACKGROUND (SAME AS 1 BUT TICKMRRKS CONNECTED) 

3 HALF-AXIS BACKGROUND 

4 NO BACKGROUND 

NPAT - SPECIFIES PATTERN OF SUCCESSIVE CURVES 

1-6 FIRST CURVE FOR UHICH SYMBOL = 'L' USES THE INTER- 
NAL DASHED-LINE PATTERN -OSHL(NPAT)-. OTHER CURVES 
USE SUCCESSIVE PATTERNS IN -DSHL- CYCLICALLY, 
REPEATING AFTER THE SIXTH PATTERN. THE DEFAULT 
-OSH.- CONTAINS: 

DSHL(I) = SOLID LINE, DSHL (2) = DOTTED LINE, 
0SHL(3> = LONG-DASH LINE, AMD 3 MORE TOT-DASH 
PATTERNS; THE USER MAY REPLACE IT AT WILL. 

<0 USES SOLID LINES WITH LETTERS EMBEDDED: THE FIRST 

LETTER USED IS THE ONE WITH NUMBER RBS(NPRT) IN THE 
ALPHABET. OTTER CURVES USE SUCCESSIVE LETTERS, 
CYCLING BACK TO 'A 1 AFTER ’Z‘ IS USED. 

SYMBOL - AN ARRAY OF SINGLE CHARACTERS, ONE FOR EACH CURVE; 

IF SYMBOL(K) * 'L\ THEN CURVE -K- IS PLOTTED TO A 
LINE WITH PATTERN DETERMINED BY 'NPAT’; OTHERWISE IT 
IS PLOTTED TO UNCONNECTED SYMBOLS AT THE DATA POINTS, 
USING - SYMBOL (K>- TO THE PLOTTING SYMBOL (TO GET TOTS, 
TO IN A SCATTERPLOT, USE fl PERIOD). 

XMIN - MIN VALUE ALONG X-AXIS (DOUBLE PRECISION) 

XMAX - MAX VALUE ALONG X-AXIS (DOUBLE PRECISION) 

YMIN - MIN VALUE ALONG Y-AXIS (DOUBLE PRECISION) 

YMAX - MAX VALUE ALONG Y-AXIS (DOUBLE PRECISION) 

SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED 
WRTBAD (VARNAM, ERFLAG) 

WRITE NAMES OF ERRONEOUS VARIABLES 
ERRMSG (MESSAG, FATAL) 

PRINTS OUT A WARNING OR ERROR MESSAGE; ABORT IF FATAL 
COMMENTS 

ASSUMES X, Y, XMIN, XMAX, YMIN, YMAX ARE DOUBLE PRECISION 
SETTING XMIN, XMAX, YMIN OR VTOX TO ZERO FORCES ’SEZMXV TO FIND 
THE CORRESPONDING VALUE DIRECTLY FROM THE ’X' TO 'Y' ARRAY 
’NPTS' IS NOW AN ARRAY RATHER THAN A SCALAR 
60-CHARACTER LABELS ARE TOW ALLOWED 

IF FOR SOME REASON YOU WANT TO OMIT A POINT, SET EITHER ITS 
X- OR Y-VALUE TO 1.E+36 (THE DO-TOT-PLOT-ME FLAG) 

REFERENCES 

KENNISON, 0., 1985: AUTOGRAPH, THE UNABRIDGED WRITEUP, NCAR 
TECH. TOTE TN-245, PP. 119-121. 
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SUBROUTINE SEZMXV (LABG, LABX, LABV, X, V, NPTS, MANV, IDXV, LTVP, 

1 LROU, LBAC, NPAT, SVMBOL, XMIN, XMflX, VMIN, 

2 VMAX) 

C — 

CHARACTER* 1 SVMBOL(* > 

CHARACTER*60 LABG, LABX, LABV 

INTEGER IDXV, LTVP, LROU, LBRC, NRNV, NPTS(*> 

DOUBLE PRECISION X(IDXV,*), V(I0XV,*), XMIN, XMflX, VMIN, VMflX 


LOGICflL INPERR, NEGflT 

INTEGER DSHL(12), LLR 

PARAMETER (MAXPT = 1000, MAXKRU = 10) 

DIMENSION XX(MAXPT, MAXKRU), W<MflXPT, MflXKRU ) 

REflL XXMIN, XXMAX, WMIN, WMflX, OMITIT 

DATA DSH. / 65535, 21845, 63736, 60335, 58255, 45967, 

1 65535, 21845, 63736, 60335, 58255, 45967 / 

DATA OMITIT / 1.E+36 / 


FOR GSPC ONLV; STOPS SPLINING OF CURVES 

CALL OASHSM (1) 


INPERR = .FALSE. 

IF <LEN<LABG ) . GT . 60 ) CALL URTBAD < 'LABG' , INPERR) 

IF <LEN<LABX ) . GT . 60 ) CALL URTBAD < ' LABX ' , INPERR) 

IF <LEN<LA6V ) . GT . 60 ) CALL URTBAD <'LABV, INPERR) 

IF <IDXV.LT.2) CALL URTBAD < ' IDXV, INPERR) 

IF <<MANV .LT. 1) .OR. <MANV .GT. 25)) 

1 CALL URTBAD <'MANV, INPEF«) 

IF «LTVP LT. 0) OR. <LTVP GT. 4)) CALL URTBAD CLTVP-, INPERR) 

IF <<LROU LT. 1) OR. CLROU .GT. 2)) CALL URTBAD < ‘LROU 1 , INPERR) 

IF <<LBAC LT. 0) OR. <LBAC GT. 4)) CALL URTBAD <’LBRC', INPERR) 

IF <<fff»AT EQ. 0) .OR. <NPAT .GT. 6)) CALL URTBAD < ' NPAT ’ , INPERR) 

NPTMAX = 0 
DO 5 K = 1,MANV 

NPTMAX = MAXO (NPTMAX, NPTS(K)) 

IF (NPTS(K) GT. IDXV) CALL URTBAD CIFTS’, INPERR) 

IF <<NPTS(K) .LT. 2) .AND. (SVMBOL(K) .EQ. ’L’)) 

1 CALL URTBAD < ‘APTS', INPERR) 

IF <<NPTS<K) LT. 1) .AND. (SVMBOL(K) NE. ‘L’)) 

1 CALL URTBAO CNPTS’, INPERR) 

5 CONTINUE 

IF (INPERR) THEN 

URITE (*,1000) LABV, LRBX, LABG 

CALL ERRMSG ( ' SEZMXV— I W»UT PARAMETER(S) Bf»‘, .FALSE.) 

END IF 

IF (NPTMAX .GT. MAXPT ) 

1 CALL ERRMSG ( * SE2MXV — I NCREASE PARAMETER MAXPT', .TRUE.) 

IF (MANV .GT. MAXKRU) 

1 CALL ERRMSG (' SE2MXV— INCREASE PARAMETER MAXKRU', .TRUE.) 

CONVERT PLOT ARRAVS TO SINGLE PRECISION 

DO 30 K = 1,MANV 
LLR = K 

IF(LROU .EQ. 1) LLR = 1 
DO 10 N = 1,NPTS(K) 
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XXCH,K> = SHGL (XCN,LLR>> 

YYCN,K> = SHGL (Y(N,K» 

IF (XX(N,K> .EQ. OMITIT) YY(N,K) - OMITIT 
IF (YY(N,K) .EQ. OMITIT) XX(N,K) = OHITIT 
10 CONTINUE 

C 

C FILL REHRINOER OF PLOT RRRflYS WITH DON ' T-PLOT-NE FLAGS 

C 

DO 20 N = NPTS(K) + 1,NPTMRX 
XX(N,K) = W1ITIT 
YY(N,K) = OHITIT 
20 CONTINUE 

30 CONTINUE 
C 

C RUOID HRUING NEGRTIUE URLUES BOHB LOG PLOTS 

C 

IF (CLTYP .EQ. 3> .OR. CLTYP .EQ. 4)) THEN 
NEGRT = .FALSE. 

DO 40 K * 1,MRNY 

DO 40 N = 1,NPTS(K) 

IF (XX(N,K) .LE. 0.0) THEN 
NEGRT = .TRUE. 

XX<N,K) = OHITIT 
W<N,K) = OHITIT 
END IF 

40 CONTINUE 

IF < NEGRT) THEN 

WRITE <*, 1000) LRBV, LRBX, LRBG 

CALL ERWSG ( ’ SEZHXV — NEGRT I UE X-URLUES OMITTED FROM PLOT.', 
1 FALSE. ) 

END IF 
END IF 
C 

IF <<LTYP .EQ. 2) .OR. CLTYP EQ. 4)) THEN 
NEGRT = FALSE. 

DO 50 K * 1,MRNY 

DO 50 N = 1,NPTSCK) 

IF <YYCN,K) .LE. 0.0) THEN 
NEGRT * .TRUE. 

XXCN,K> = OMITIT 
YYCN,K) = OMITIT 
END IF 

50 CONTINUE 

IF (NEGRT) THEN 

WRITE <*, 1000) LRBV, LRBX, LRBG 

CALL ERRMSG ( ‘ SEZHXY — NEGRT I UE Y-URLUES OMITTED FROM PLOT.', 
1 . FALSE . ) 

EM) IF 
EM) IF 
C 

CALL DISPLR <2, LROW, LTVP ) 

IF CNPRT GE. 1) CRLL RNOTRT CLRBX, LRBY, LBRC, 0, 6, DSHLCNPRT)) 
IF CNPRT LT. 0) CRLL RNOTRT CLRBX, Lf®Y, LBRC, 0, NPRT, '0') 

CUT OFF CURUES OUTS ICE FRRME 

CRLL RGSETF C WINDOW.’, 1.0) 

C 
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MAKE CURUES GO RIGHT TO EDGE OF FRRHE INSTEAD OF PICKING ’NICE' 
MINIMUM ANO MRXIMUM URLUES 

IF ((LTYP .EQ. 2) .(Ml. (LTYP .EQ. 4)) 

1 CflLL RGSETF ('Y/NICE.', 0.0) 

IF ((LTYP .EQ. 3) .OR. (LTYP .EQ. 4)) 

1 CALL RGSETF CX/NICE.', 0.0) 

SET LOWER AND UPPER BOUNDS 

XXMIN = 1.0E+50 

XXMRX = -1.0E+50 
WMIN » 1.0E+50 

WMflX - -1.0E+50 
DO 60 K = 1,MRNV 

DO 60 N = 1,NPTS(K) 

IF (XX(N,K) .NE. OMITIT) THEN 
XXMIN = RMIN1(XXMIN,XX(N,K)) 

XXMRX = flMflX1(XXMflX,XX(N,K)) 

WMIN = RMINKWMIN, W(N,K)) 

WMflX * AMAX 1< WMflX, W(N,K)) 

END IF 

60 CONTINUE 

IF <XMIN .NE. 0.0) XXMIN = SNGL(XMIN) 

IF (XHfiX .NE. 0.0) XXMRX = SNGL(XMflX) 

IF (YMIN .NE. 0.0) WMIN = SNGL(YMIN) 

IF (YMAX .NE. 0.0) WMflX = SNGL<VMflX) 

IF <XHIN .EQ. 0.0) XMIN = DBLE(XXMIN) 

IF (XMAX EQ. 0.0) XMflX = DBLE (XXMRX) 

IF <VMIN .EQ. 0.0) VMIN = DBLE(WMIN) 

IF (YMAX .EQ. 0.0) VMflX = DBLE(WMAX) 

IF (XXMIN .GE. XXMRX) HEN 

WRITE (*,1000) LABV, LABX, LRBG 

CflLL ERRMSG CSEZMXY— HIN AND/OR MAX OF X-flRRflV BAD', .FALSE.) 

RETURN 

END IF 

IF (WMIN GE. WMflX) THEN 

WRITE (*,1000) LABV, LflBX, LflBG 

CflLL ERRMSG CSEZMXV— MIN AND/OR MAX OF V-flRRRV BAD 1 , .FALSE. ) 

RETURN 

END IF 

CALL RGSETF CX/MIN.', XXMIN) 

CALL RGSETF CX/MflX.', XXMRX) 

CALL AGSETF CY/MIN. ' , WMIN) 

Cffl.L AGSETF CY/MAX.', WMRX) 

MAKE TICK MARKS POINT IN 

CflLL AGSETF ( 'LEFT /MAJOR/ IN. ' , 0.015) 

CflLL AGSETF ( 'RIGHT /MAJOR/ IN. ' , 0.015) 

CflLL AGSETF ( 'BOTTOM /MAJOR /IN. ' , 0.015) 

CflLL AGSETF C TOP /MAJOR/ IN. ' , 0.015) 

CflLL AGSETF ( 'LEFT /MAJOR /OUT. ' , 0.0) 

CALL AGSETF ( 'RIGHT /MAJOR /OUT. ' , 0.0) 

CALL AGSETF ( ' BOTTOM /MAJOR /OUT . ' , 0.0) 

CflLL AGSETF ( ' TOP /MAJOR/OUT .’,0.0) 

CflLL AGSETF ( 'LEFT /MINOR/IN. ' , 0.0075) 
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CflLL RGSETF < 'RIGHT /MINOR/IN. 1 , 0.0073) 

CflLL RGSETF C BOTTOM/M I NOR/ IN. ' , 0.0075) 

CflLL RGSETF < 'TOP /MINOR/ IN. ' , 0.0075) 

CflLL RGSETF < 'LEFT /MINOR /OUT. ' , 0.0) 

CflLL RGSETF < 'RIGHT /MINOR /OUT. 0.0) 

CflLL RGSETF ( 'BOTTOM /Ml NOR /OUT. ' , 0.0) 

CflLL RGSETF ( 'TOP /Ml NOR /OUT. \ 0.0) 

SET TOP LflBEL 

CflLL RGSETF ( 'LINE/MRXIMUM. ' , 60.0) 

CflLL flGSETF ( 'LflBEL/NflfE. ' , 'T') 

CflLL AGSETI ( 'LHC /NUMBER. ' , +100) 

CflLL flGSETF ('Ll NE/CHflRftCTER . ' , 0.015) 

CflLL flGSETP ('LINE/TEXT. LflBG, LEN(LftBG)) 

DO SETUP TASKS 

CflLL flGSTUP (XX, MRNY, IOXY, NPTMflX, 1, W, tlflNY, IDXY, NPTMflX, 1) 

DRflM BACKGROUND 

CflLL flGBftCK 
I OSH = NPflT 
INC = 1 

IF (NPflT LT. 0) INC = - 1 
DO 100 K = 1,MftNY 

IF(SV1B0L(K> .EQ. 'L' ) THEN 

CflLL flGCURU (XX( 1,K>, 1, W(1,K), 1, NPTS(K), IDSH) 

IDSH = IDSH + INC 

ELSE IF (SVMBOL(K) .EQ. '.') THEN 

CflLL POINTS (XX(1,K), VY(1,K), NPTS(K), 0, 0) 

ELSE 

CflLL POINTS (XX(1,K), W(1,K>, NPTS(K), SVMBOL(K), 0) 
END IF 

100 CONTINUE 
CflLL FRAME 

RESTORE SOME DEFAULTS 

CflLL flGSETF CV/NICE.', -1.0) 

CflLL flGSETF CX/NICE.', -1.0) 

CflLL flGSETF CV/MIN.', OMITIT) 

CflLL flGSETF CV/MflX.', OMITIT) 

CflLL flGSETF CX/MIN.', OMITIT) 

CALL flGSETF CX/MAX.', OMITIT) 

RETURN 

1000 FORMAT ( /, ' ERROR IN PLOTTING ’ , A, /, 16X, US ' , A, /, 

1 ' GRAPH LflBEL = ', A, / ) 

END 

SUBROUTINE URTBflO 
PURPOSE 

WRITE NAMES OF ERRONEOUS UflRlflK.ES 
USAGE 

CflLL URTBflD (UflRNfiM, ERFLflG) 
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DESCRIPT I OM OF PARAMETERS 

UARNAM - NOME OF ERRONEOUS UflRIflBLE TO BE WITTEN (CHARACTER, 
ANV LENGTH) 

ERFLAG - LOGICAL FLAG, SET TRUE BY THIS ROUTINE 

SUBROUT H€S AND FUNCTION SUBPROGRAMS REQUIRED 
NONE 

SUBROUTINE URTBRD (UARNAM, ERFLRG) 


CHARACTERS*) UARNAN 
LOGICAL ERFLAG 

INTEGER MAXMSG, NUMMSG 

SAME NU1MSG, MAXMSG 

DATA NUMMSG / 0 /, MAXMSG / 50 / 


NUMMSG = NUMMSG + 1 

WRITE <*, ' <3A)' ) ‘ **** INPUT UAR I ABLE ', UARNAM, 

1 ' IN ERROR **♦*' 

ERFLAG = TRUE. 

IF (NUMMSG EQ. MAXMSG) 

1 CALL ERRMSG ('TOO MANY INPUT ERRORS. ABORTING. . .$', .TRUE.) 
RETURN 
END 

SUBROUTINE ERRMSG 
PURPOSE 

PRINTS OUT A UARNING OR ERROR MESSAGE ; ABORT IF FATAL 
USAGE 

CALL ERRMSG (MESSAG, FATAL) 

DESCRIPTION OF PARAMETERS 

MESSAG - UARNING OR ERROR MESSAGE TO BE PRINTED 
FATAL - LOGICAL FLAG 

.TRUE. FATAL ERROR, URITE MESSAGE AND STOP PROCESSING 
FALSE. URITE ERROR MESSAGE AND CONTINUE PROCESSING 

SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED 
NONE 

SUBROUTINE ERRMSG (MESSAG, FATAL) 


CHARACTERS*) MESSAG 

LOGICAL FATAL, ONCE 

INTEGER MAXMSG, NUMMSG 

SAUE MAXMSG, NUMMSG, ONCE 

DATA NUfflSG / 0 /, MAXMSG / 100 /, ONCE / .FALSE. / 


IF (FATAL) THEN 

URITE (*, , (2A)’) ' ******* ERROR >>>>>> MESSAG 

STOP 

END IF 

NUMMSG = NUMMSG +1 
IF (NUMMSG GT. MAXMSG) THEN 


IF C.riOT. ONCE) WRITE <+, 1000) 

ONCE = TRUE. 

ELSE 

WRITE < *, ’<2A)’ ) ' ******* WARNING >>>>>> NESSAG 
END IF 

RETURN 

1000 FORHATC///, ' >>>>>> TOO MANY WARNING MESSAGES — 

1 'THEV WILL NO LONGER BE PRINTED <<<<<<', /// > 

END 



Appendix B 


PHIPLOT 


PHIPLOT Plot Example 
Program Listing 
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PROGRAM PH I PLOT - 05/16/88 
PURPOSE 

PLOT THE PHI DATA FROM THE CLOUD ABSORPTION RAO IOMETER 

DESCRIPTION OF PARAMETERS 

- VARIABLE FOR USE BY CARNAL VS 

- ARRAY OF WAVELENGTHS IN MICROMS 

- ARRAY OF CAL I BRAT I (Si SLOPES IN W/(CM**2*M I CRON*SR*V > 

- ARRAY OF CALIBRATION INTERCEPTS IN MW/(CM**2*MICR0N*SR) 

- ARRAY OF GROUND ALBEDOS ( UAVELENGTH ) 

- ARRAY OF GROUND ALBEDO STANDARD DEVIATIONS (WAVELENGTH) 

- PRINTER PLOTS <.NE. 0 = YES) 

- ZETA PLOTS (TEMPLATE TO ZETA) (.NE. 0 * YES) 

- HARD COPY PLOTS (TEMPLATE TO 3800) (NE. 0 = YES) 

- PLOT SCALING, NUMBER OF SCANS AVERAGED /PLOTTED VALUE 
0,1 - ALL SCANS PLOTTED (NO COMPRESSION) (6 SEC/IN) 

2-2 SCANS AVERAGED (12 SEC/IN) 


20 - 20 SOWS AVERAGED (120 SEC/IN) 

- ARRAY OF FIRST SOW LINES TO BE PROCESSED 
IF I SCAN 1 .EQ. 0, START RT BEGINNING OF FILE 

- ARRAY OF LAST SOW LINES TO BE PROCESSED 
IF ISCAN2 .EQ. 0, ETC AT EOF 

SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED 
READS 

READ AND LIST DATA CARDS AND REWIND INPUT LOGICAL UNIT 5 
CAROAT (ISCAN1, ISCAN2, WUL, CALSLP, CAL I NT, 

NFLT, NSC AN, KSCAN, ITIft, PHI, ICH8, NPRSS) 

READ AIRCRAFT DATA FOR SCRN LINES BETWEEN I SCAN 1 ANO ISCAN2 
PRINTR (WUL, CALSLP, CAL I NT, 

NFLT, NSCAN, KSCAN, ITIME, PHI, ICH8) 

CREATE PRINTER PLOT OF PHI DATA 
2ETA (NSC ALE, WUL, CALSLP, CAL I NT, INDEX, NPASS, 

NFLT, NSCAN, KSCAN, ITIME, PHI, ICH8) 

CREATE ZETA PLOT OF PHI DATA 

DESCRIPTION OF INPUT DATA DECK 
MODE 
WUL(1) 

CALSLP ( 1 ) 

CALTNT( 1 ) 

AG0(1) 

SIGAG(I) 

PRTPLT 
ISOWK1) 


ISCANKN) 

COfIMEHTS 

PROGRAM IS MOSTLY DOUBLE PRECISION (EXCEPT PLOT VARIABLES) 
ARRAYS ARE DIMENSIONED FOR IP TO 20000 SCAN LINES 


. . . WVL( 13) 

. . . CALSLP ( 13) 

. . . CALINT(13) 

. . . AG0(13) 

. . . SIGAG( 13) 

ZTAPLT HRDPLT NSCALE 
ISCAN2( 1 ) 


ISCRN2(N> 


MODE 

WVL 

CALSLP 

CAL I NT 

AGO 

SIGAG 

PRTPLT 

ZTAPLT 

WffiPLT 

NSCALE 


I SCAN 1 
ISCAN2 
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RRRAYS ARE DIMENSIONED FOR UP TO 13 WAVELENGTHS 
REFERENCES 

KING, f1. D., 1981: J. RTMOS. SCI., 38, 2031-2044. 

MODIFICATIONS 

04/13/88 - ADO VARIABLE PLOT SCALES (SECS/IN). LIMIT LENGTH 
OF PLOTS TO 30 INCHES <36 INCHES WITH ENO LABELS) 
ONLV WITH I SCAN 1 AND ISCAN2 

05/16/88 - MAKE TOLL AND GAIN CALCULATIONS COMPATIBLE WITH 
CARANLVS 

IMPLICIT DOUBLE PRECISION <A-H,0-Z> 

REAL PHI<20000,8) 

DIMENSION ICH8<20000),KSCAN<20000> 

DIMENSION AGO< 13),SIGAG< 13),WL( 13),CALSLP< 13),CALINT< 13) 
DIMENSION I SCAN 1(50), ISCAN2<50),NSCAN<50) 

INTEGERS ITIME<20000,3) 

I PLOT = 0 

CALL READS 

READ<5, 1000) MODE 

READ<5, 1010) <WUL<I), 1=1,13) 

READ<5, 1010) <CALSLP< I ), 1=1,13) 

READ<5, 1010) (CALINT(I), 1 = 1,13) 

READ<5, 1010) <AGO<l ), 1=1, 13) 

READ<5, 1010) <SIGAG<I ), 1=1, 13) 

READ<5, 1000) PRTPLT, ZTAPLT, TODPLT, NSCRLE 
CALL CAROAT < I SCAN 1 , ISCAN2,WUL,CALSLP,CALINT, 

1 NFLT,NSCAN,KSCAN, ITIME,PHI , ICH8,NPRSS) 

PRODUCE PRINTER PLOTS IF DESIRED 

IF (PRTPLT .NE. 0) THEN 
DO 20 I = 1,NPASS 
ISCEND = 0 
TO 10 II = 1,1 

ISCEND = ISCEND + NSCAN(II) 

10 CONTINUE 

ISCSTR = ISCEND - NSCANd ) + 1 
NSCAN1 = NS CAN < I ) 

CALL PRINTR<WUL,CALSLP,CALINT, ISCSTR, ISCEND, 

1 NFLT,NSCAN1,KSCAN, ITIME,PHI , ICH8) 

20 CONTINUE 

END IF 

PRODUCE ZETA PLOTS IF DESIRED 

IF (ZTAPLT .NE. 0) THEN 
DO 30 I = 1,NPRSS 
INDEX = I 

CALL ZETA(NSCALE,WUL,CALSLP,CRLINT, INOEX,NPASS, 

1 NFLT,NSCAN,KSCAN, ITIME,PHI , I CHS) 

30 CONTINUE 

END IF 

999 STOP 

1000 F0RMAT(7I 10) 

1010 FORMAT(TDIO.O) 

END 
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SUBROUTIfC READS 


PURPOSE 

READ AMD kffflTE INPUT DRTR CARDS FROM LOGICAL UMIT 5 
USAGE 

CALL READS 

DESCRIPTION OF PARAMETERS 
NONE 

SUBROUTINES AND FUNCTION SUBPROGRAMS REWIRED 
NONE 

COMMENTS 

SUBROUTINE REMINDS LOGICAL UNIT 5 SO THE INPUT IS READY TO BE 
READ BY THE PROGRAM 

SUBROUTINE READS 
DIMENSION CARD (18) 

WRITEC6, 1000) 

10 RERD<5, 10 10, EN0=999 > CARD 
HRITE<6, 1020) CARD 
GO TO 10 
999 CONTINUE 
REMIND 5 
RETURN 

1000 FORMAT < 1H1, //, 10X, 'THE CONTENTS OF THE INPUT FILE ON UNIT 5 ARE:', 
1 //) 

1010 F0RMAT(18A4) 

1020 FORMATOOX, 18A4) 

END 

SUBROUTIfC CARDAT 
PURPOSE 

READ AIRCRAFT DATA FOR SCRN LlfCS BETWEEN I SCAN 1 AND ISCAN2 
USAGE 

SUBROUTINE CARDAT < I SCAN 1 , ISCAN2, MUL, CALSLP, CAL I NT, 

NFLT, NSCAN, KSCAN, ITIME, PHI, I CHS, NPASS) 

ASCRIPTION OF PARAMETERS 

I SCAN 1 - ARRAY A FIRST SCAN LINES TO BE PROCESSED 
ISCAN2 - ARRAY A LAST SCRN LINES TO BE PROCESSED 
MUL - ARRAY A MAUELENGTHS IN MICRONS 

CALSLP - ARRAY A CALIBRATION SLOPES IN MU/<CH**2*MICR0N*SR*U) 
CAL I NT - ARRAY A CALIBRATION INTERCEPTS IN MM/<CM**2*MICR0N*SR) 
ALT - FLIGHT NUMBER 

NSCAN - ARRAY A NUMBERS A SCRN LINES PROCESSED 
KSCAN - ARRAY A SCAN Lift NUMBERS PROCESSED 
ITIME - ARRAY A TIMES A PROCESSED SCAN LINES 
PHI - ARRAY. A RATIO A INTENSITIES AT THETA = 180 AGREES 

DIUIOED BY THE INTENSITIES AT THETA = 0 AGREES 
ICH8 - ARRAY OF FILTER POSITION FOR EACH SCAN Lift 
NPASS - NUMBER A SCAN LINE PAIRS PROCESSED 

SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED 
NONE 
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DESCRIPTION OF INPUT DATA DECK 
SEE MAIN 

COMMENTS 

SUBROUTINE IS MOSTLV DOUBLE PRECISION (EXCEPT PLOT VARIABLES) 
ARRAVS ARE DIMENSIONED FOR IP TO 20000 SCAN Lifts 
THIS VERSION OF CARDAT IS NOU MARKEDLY DIFFERENT FROM THE 
CARANLYS VERSION, BUT THE COMPUTATIONAL PARTS Aft THE SAME 

REFERENCES 

NONE 

SUBROUTINE CARDAT ( I SCAN 1 , ISCfflH2,WVL,CALSLP,CALINT, 

1 NFLT,NSCAN,KSCAN,ITIME,PHI,ICH8,NPRSS) 

IMPLICIT DOUBLE PRECISION <A-H,0-Z> 

DOUBLE PRECISION INTEN(2,8) 

REAL PHI <20000, 8), SLOPE, Y I NTCP 

DIMENSION KSCAN<20000>, ICH8<20000) 

DIMENSION LC0UNT<435, 8 ), V0LT<435, 8 ), THETA<435 ), AMU<435 ) 
DIMENSION HVL< 13),CALSLP< 13>,CALINT< 13) 

DIMENSION NSCRN<1), ISCANK1), ISCAN2<1) 

I NTEGER*2 IDATA<3505>, ITIME(20000,3) 

CHARACTERS CHRPHI <6>,BLANK,CPHI 

EQU I VALENCE < I 0ATA< 11), SLOPE ), ( I DATA< 13 ), Y I NTCP ) 

FRCTR = 180.000/(2**11) 

SIGN * 1.0 

PI = OARCOS<- 1.000) 

DEGRAD * PI / 180000 

READ<5, 1000) ISCANK 1 ), ISCAN2< 1 ) 

DO 5 I * 1,50 
NSCAN< I ) =0 
5 CONTINUE 
NSCN = 0 
NPASS = 1 

READ DATA FOR SINGLE SCAN LINE FROM AIRCRAFT TAPE 

10 READ< 10, 1Q1Q,END=90) IDATA 
LSCAN * IDATR(5) 

IF (LSCAN LT. ISCANKNPRSS)) GO TO 10 
IF (ISCANK NPASS) ,EQ. 0) ISCANKNPRSS) = LSCAN 
IF ((LSCAN .GT. ISCAN20PASS)) .fiffl). 

1 ( ISCAN2(NPASS) .NE. 0)) GO TO 80 

NFLT = IDATA(IO) 

NANGS - IDATA<20) 

DT = 190.000 / (NANGS- 1 ) 

DO 20 I = 1, NANGS 

1>ETA<I) = (1-1 )*DT - 5.0D0 
20 CONTINUE 

IF < IDATA(9) .LT. 128) RROLL = IDRTR(9)*FACTR 
IF < IDATA<9) .GE. 128) RROLL = < I DRTR(9 )-256 )*FRCTR 
IF (NFLT .GE. 1139) RROLL = 4.000+AR0LL 
IF ((RROLL .LT. -4.5D0) OR. (RROLL GT. 5.0D0)) TI-EN 
IF (LSCAN EQ. ISCRN2(NPRSS)) GO TO 80 
GO TO 10 
END IF 


CHfiNGE THE SIGH OF TIC ROLL FOR THE C0WAIR-131A RIRCRRFT 


IF <NFLT .GE. 1160) AROLL - -AROLL 
IF (( IDATA( 19) GE. 0) .AND. (IDATA(19) .LE. 2>> THEN 
IF (IDATA(19) .EQ. 0) GRIN = 0.500 
IF ( IDRTR< 19) .EQ. 1) GRIN => I.ODO 
IF (IDATA(19) .EQ. 2) GRIN = 2 000 
ELSE 

IF (LSCAN EQ. ISCRN2<W 5 RSS>) GO TO 80 
GO TO 10 
END IF 

NSCRN<NPfiSS ) = NSCRN(NPRSS) + 1 

NSCN * NSCN + 1 

IF (NSCN .GT. 20000) GO TO 90 
KSCRN(NSCN) = IDRTfl<5) 

ITINE(NSCN, 1) = IDRTR<2) 

ITIME(NSCN,2> * IDRTR(3) 

ITIHE(NSCN,3) = I0ATA(4) 

ICH8(NSCN) * I0RTR<6) + 7 

CONUERT COUNTS TO UOLTRGE 

DO 40 N = 1,NANGS 

I OFF = 23 + 8*(N-1 ) 

DO 30 I = 1,8 

INF = I OFF + I 

LCOUNTCN, I ) = IDRTfi(INP) 

UOLT(N, I ) = <LCOUNT(N, I) - V I NTCP VSLOPE 

CONTINUE 
CONTINUE 

LOCATE PIXELS RT THE ZENITH AND NADIR DIRECTIONS 

IF (NFLT LT. 1160) SIGN = -1.0 
EPS1 * 0. IDO 

EPS2 = 0. IDO 

DO 60 N = 1 , NRNGS 

ANGLE = (THETA(N) + S I GN*AROLL >*DEGRAD 
AHU(N> = OCOS< ANGLE) 

DIFF = DABS(AMU(N) - I.ODO) 

IF (DIFF .GT. EPS1 ) GO TO 50 
EPS1 = DIFF 
10 * N 

DIFF = OABS(AHU(N> + I.ODO) 

IF (DIFF .GT. EPS2) GO TO 60 
EPS2 = DIFF 
I 180 = N 

CONTINUE 

CONUERT UOLTRGE TO I NTENS I TV AND CREATE PHI ARRAV 

DO 70 K = 1,8 
KK = k 

IF (K .EQ. 8) KK = I CHS (NSCN) 

IF ((K .EQ. 8) AND. (KK EQ. 7>) GO TO 70 
INTEN( 1,K) = (UOLT( IO,K)*CALSLP(KK) + CALINT(KK)) / GAIN 
INTEN(2,K) = (UOLTd 180,K)*CALSLP(KK) + CALINT(KK)) / GAIN 
PHI (NSCN,K) = INTEN(2,K) / INTEN( 1,K) 
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70 CONTINUE 

IF (LSCAN .EQ. ISCAN2(NPASS)) GO TO 80 
GO TO 10 

80 IF <<NPASS+1) GT. 50) GO TO 90 

REA0C5, 1000,END=90) ISCANKNPASS+1 ), ISCAN2<1f > ASS+1 > 

NPASS = NPfiSS + 1 
GO TO 10 

WRITE OUT PHI TABLE 

90 DO 110 I = 1,NSCN 
DO 100 J = 1,6 

CHRPHKJ) = BLANK 
100 CONTINUE 

IF <FHI<I,8> NE. O.ODO) THEN 
URITECCPHI, 1020) PHKI,8> 

ICHN = ICH8< I ) - 7 
CHRPHI(ICHN) * CPHI 
END IF 
INI * I - 1 

IF <M00<IM1,56) EQ. 0) URITE<6, 1030) <K,K=1,13) 

URITE<6, 1040) KSCAN<I ),<PHm,J),J=1,7),<CHRPHI<J),J=1,6) 

110 CONTUSE 
RETURN 

1000 F0RMRT<7I 10) 

1010 F0RMAT<71<8OA2>) 

1020 F0RMAKF9.5) 

1030 F0RHAT< 1H1,/, 

1 6H SOW, 13<2X,4HPHK,I2, 1H)),/, 1X,5<1H->, 13<2X,7< 1H-))) 

1040 FORMAT <16, 7F9 . 5, 6A9 ) 

END 

SUBROUT I IE PRINTR 
PURPOSE 

CREATE PRINTER PLOT OF PHI DATA 
USAGE 

SUBROUTINE PRINTR CUUL, CALSLP, CAL I NT, ISCSTR, ISCEND, 

NFLT, NSCAN, KSCAN, ITINE, PHI, ICH8) 

DESCRIPTION OF PARAMETERS 

UUL - ARRAV OF UAUELENGTHS IN MICRONS 

CALSLP - ARRAV OF CALIBRATION SLOPES IN MU/ <CM**2*M I CRON*SR*U ) 
CAL I NT - ARRAV OF CALIBRATION INTERCEPTS IN MU/<CM**2*MICR0N*SR) 
ISCSTR - START INDEX IN ARRAVS FOR THIS CALL 
ISCEND - END INDEX IN ARRAVS FOR THIS CALL 
NFLT - FLIGHT NUMBER 

NSCAN - NUMBER OF SCAN LINES PROCESSED 

KSCAN - ARRAV OF SCAN LINE NUMBERS PROCESSED 
I T I ME - ARRAV OF TIMES OF PROCESSED SCAN LINES 

PHI - ARRAV OF RATIO OF INTENSITIES AT THETA = 180 DEGREES 

OIUIDED BV TIC INTENSITIES AT THETA = 0 DEGREES 
ICH8 - ARRAV OF FILTER POSITION FOR EACH SCAN LINE 

SUBROUTINES FUNCTION SUBPROGRAMS REQUIRED 
NOIC 


DESCRIPTION OF INPUT DATA DECK 


NONE 


C 
C 

C COMMENTS 

C SUBROUTINE IS SINGLE PRECISION (EXECPT NON-PLOT VARIABLES) 

C RRRflVS ARE DIMENSIONED FOR IF TO 20000 SCAN LINES 

C PLOT CHARACTER CORRESPONDENCE TO CHANNEL NUMBER: 

C CHANNEL CHARACTER 


C 1 * 

C 2 + 

C 3 « 

C 4 

C 5 

C 6 $ 

C 7 8 

C 8-13 & 

C 

C REFERENCES 

C IOC 

C 


SUBROUTINE PRINTR<UUL,CALSLP,Cffl.lNT, ISCSTR, ISCEND, 

1 NFLT,NSCAN,KSCAN, (TIME, PHI, ICH8) 

DOUBLE PRECISION UUL<1),CALSLP<1),CAUNT<1) 

DIMENSION PHI <20000,8),KSCAN< 1 ), ICH8( 1 ),TENTHS< 1 1 ) 

INTEGERS ITIME<20000,3) 

CHARACTER* 1 L I NE< 1 19 >, BLNKLN< 119), CHAR<8 >, BLANK 1 , UERT 
DATA CHAR/ , *V + V*V, V- V*V*V*'/ 

ORTA BLANK 1/' , /,UERT/ , |'/ 

DATA BLNKLN/ ‘ | , 8* 1 ’/I ’,99*' ',‘l',8** ',’1 V 

DATA TENTHS/0.0,0. 1, 0.2,0. 3,0. 4,0. 5,0. 6,0. 7,0. 8,0. 9, 1 .0/ 

URITEC6, 1000) NFLT,KSCAN< I SCSTR),KSCAN< ISCEND), 

1 < IT I fEC ISCSTR, I ), 1 = 1,3), < ITIME< ISCEND, I ), 1 = 1,3), 

2 <I,UUL<I),CALSLP<I),CALINT<I),I=1,13) 

N * ISCSTR - 1 

NSC = KSCAN< ISCSTR) 

C 

C START A NEU PAGE 

C 

10 IFITE<6, 1010) <I,CHAR<I>, 1 = 1,7), < 1 , 1=8, 13,5>,CHAR<8) 

WRITE<6, 1020) (TENTHSd), 1 = 1,11) 

URITE<6, 1030) 

11=0 
IE = 0 

20 11=11+1 

IE = IE +1 
N = N + 1 
NSC = NSC + 1 
DO 30 ICO. = 1, 119 

LINE(ICOL) = BLNKLN < I COL) 

30 CONTINUE 

00 40 J = 1,8 r 

IF <PHKN,J) .LT. 0.0) THEN 
LINE<J+1> = CHAR<J) 

GO TO 40 i J 'i~.IL'." ; " • :L... ^ 

END IF 

IF <PHI <N, J) GT. 1.0) THEN 
LINECJ+107) = CHAR<J) 

GO TO 40 
Ehff) IF 


IF ((J .EQ. 8> .AND. (PHI(N,J) .EQ. 0.0)) GO TO 40 

I PHI = PHI (N, J) * 100.0 

I COL - 10 + I PHI 

IF < ICOL .EQ. 100) ICO. = 99 

LINE(ICOL) = CHAR(J) 

40 CONTINUE 

IF <<IE EQ. 1) OR. (MOD(IE, 10) EQ. 0)) THEM 
LINE(1) = CHAR(2> 

LIME< 10) = CHAR(2> 

LINE(IIO) = CHAR(2> 

LIME< 119) = CHRR(2> 

END IF 

URITE(6, 1040) (LINE( ICOL) , IC0L=1, 119) 

IF << IE .EQ. 1) .OR. (N00(IE, 10) .EQ. 0)> 

1 URITE(6, 1050) < ITIHE<N, IT), I T= 1,3),KSCAN(N> 

IF <HSC .EQ. KSCRN(M)) GO TO 70 
50 IF <MSC .NE. KSCRN(N+1 >) ITCH 
II =11 +1 

IF (II LE. 50) WRITE(6, 1040) <BLNKLM( ICOL), IC0L=1, 1 19) 
NSC = NSC + 1 

IF (NSC .GT. KSCAN(ISCEND)) GO TO 70 
IF (NSC .EQ. KSCRN(N)) GO TO 70 
IE = 0 
GO TO 50 
END IF 

IF (II .LT. 50) GO TO 20 
URITE(6, 1030) 

HRITE(6, 1020) (TENTHS( I >, 1 = 1, 1 1 ) 

GO TO 10 

70 HRITE(6, 1030) 

MRITE(6, 1020) (TENTHS( I ), 1=1, 1 1 ) 

RETURN 

1000 FORNRT( 1H1, /, 

1 37H THE FOLLOUING PHI PLOT DRTfi RRE FOR:,/, 

2 15H-FLIGHT NUMBER: , 15, //, 

3 19H START SCRN NUMBER:, 16, 5X, 16HEND SCRN NUMBER:, I 6,//, 

4 12H START TIME: , 17, 1H: , 12, 1H: , I2,4X, 

5 1CW ENO TIME:, 17, 1H:, 12, 1H:, 12,/////, 

6 38H THE CHRWCL DEPENDENT PARAMETERS ARE:,///, 

7 1 1X, 10HUAUELENGHT,4X, 17HCALIBRATI0N SLOPE, 5X, 

8 21HCRLIBRATI0N INTERCEPT, /,8H CHANNEL, 5X,7W1 1 CRONS, 4X, 

9 20HMU /CM**2-M I CRON-SR-U , 4X , 18HMU/CM**2-MICR0N-SR, /, 

R IX, 7( 1H-),3X, 10( 1H-),3X,20( 1H-),3X,21( 1H-), /, 

B ( I6,F13.4,F18.4,F23.3)) 

1010 FORMAT ( 1H 1 , /, 9X, 

1 8HCHWt€L:,7( IX, 1 1,2H=>,A1, 1H, ), IX, I 1, 1H-, I2,2H=>,A1, ///, 

2 67X,3HPHI , /) 

1020 FORMATdOX, 11(7X,F3. 1» 

1030 FORMAT (9X, 1H+,8( 1H-), 1H+, 10(9( 1H-), 1H+),8( 1H-), 1H+) 

1040 FOTMAT (9X, 1 19A 1 ) 

1050 F0RMRT( 1H+, I2,2( 1H: , 12), 1 19X, 15) 

END 

C SUBROUTINE ZETA 

C 

C PURPOSE 

C CREATE ZETA PLOT OF PHI DATA 

C 
C 


USAGE 


oooooooooooooooooooooooooooooooooooooooooooooonoo 


SUBROUTINE ZETR (NSCRLE, WL, CflLSLP, CRLIMT, INDEX, IFRSS, 
WLT, NSCRN, KSCHN, ITIME, PHI, ICH8) 

DESCRIPTION OF PARAMETERS 

NSCRLE - PLOT SCALING, NUMBER OF SCRNS RUERRGED /PLOTTED URLUE 
0,1 - ALL SCANS PLOTTED (NO COMPRESSION) <6 SEC/IN) 
2-2 SCRNS RUERRGED (12 SEC/IN) 


20-20 SCRNS RUERRGED (120 SEC/IN) 

UUL - RRRflV OF URUELENGTHS IN MICRONS 

CflLSLP - RRRflV OF CRLIBRRTION SLOPES IN MU/(CM*S*M I CRON*SR*U ) 
CRLIMT - RRRflV OF CALIBRATION INTERCEPTS IN MW/(CM*S*M I CRON+SR ) 
INDEX - INDEX OF THIS CALL TO ZETR 
NPRSS - TOTAL NUMBER OF CALLS TO ZETR 
NFLT - FLIGHT NUMBER 

NSCRN - NUMBER OF SCRN LINES PROCESSED 

KSCRN - RRRflV OF SCRN LINE NUMBERS PROCESSED 
ITIME - RRRflV OF TIMES OF PROCESSED SCRN LINES 

PHI - RRRflV OF RATIO OF INTENSITIES RT THETR = 180 DEGREES 

DIVIDED BV TIC INTENSITIES RT THETR = 0 DEGREES 
I CHS - RRRflV OF FILTER POSITION FOR EflCH SCRN LINE 

SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED 
TEMPLATE PLOT PRCKRGE 

DESCRIPTION OF INPUT DATA DECK 
NONE 

COMMENTS 

SUBROUTINE IS SINGLE PRECISION (EXECPT NON-PLOT URRIABLES) 

RRRRVS WE DIMENSIONED FOR UP TO 20000 SCRN LINES 

PLOT CHARACTER CORRESPONDENCE TO CHANNEL NUMBER: 

CHWNEL CHRRRCTER TEMPLATE CODE 

1 

2 

3 

4 

5 

6 
7 

8-13 

REFERENCES 
NONE 

SUBROUTINE ZETR (NSCRLE, HUL, CflLSLP, CRL I NT, INDEX, NPRSS, 

1 NFLT, NSCRN, KSCRN, ITIME,PHI , ICH8) 

DOUBLE PRECISION UUL( 1 >,CflLSLP( 1 >,CRLINT( 1 ) 

DIMENSION PHI (20000, 8), KSCRN ( 1 ), ICH8( 1 ),NSCRN( 1 > 

CHARACTERS CHRN(8),CFLT 
CHARACTERS TENTHSdl) 

CHARACTERS CHR,CMN,CSC 
CHARACTERS CLN,CIS 
INTEGERS ITIME(20000,3) 


SQURfC 

1.0 

CIRCLE 

2.0 

TRIANGLE 

3.0 

PLUS 

4.0 

DIAMOND 

5.0 

SQUARE /OIRMOM® 

6.0 

CIRCLE/PLUS 

8.0 

SQUARE /PLUS 

9.0 


oooooooon ooo ooo 


DftTfl CHAN /■ 1$’,' 2$’,’ 3$'/ 4$’, 

1 ' 5$’/ 6$’/ ? $ ' , ' 8- 13$ ’ / 

DATA TENTHS/ '0.0$ VO. 1$’ , ’0.2$' , ’0.3$’ , ’0.4$’ , '0.5$' , 

1 '0.6$V0.7$\ 0.8$ /0.9$ - / 1.0$'/ 

DATA CLN /’:$’/ 

IF (INDEX .EQ. 1) THEN 
CALL UC0NFG<51 .0) 

CALL USTART 

CALL UPSETCFNTF’, 11.0) 

CALL UFONT < ‘ SRON ' > 

END IF 

DEFINE STARTING AND ENDING ARRAV HCICIES FOR THIS PASS 

ISCEND = 0 
DO 5 I = 1, INDEX 

ISCEND = ISCEND + NSCAN(I) 

5 CONTINUE 

ISCSTR = ISCEND - NSCAN( INDEX) + 1 

SEARCH FOR END OF MONOTON I CALLV INCREASING SCAN LINE NUMBER 

NSCN = ISCSTR 
ISTRP1 = ISCSTR + 1 
DO 10 NS = ISTRP1, ISCEND 

IF (KSCAN(NS) LE. KSCAN(NS-D) GO TO 20 
NSCN = NS 
10 CONTINUE 

CALCULATE LENGTH OF PLOT ( 10+NSCALE SCAN LINES/ INCH), ADJUST THE 
UIRTUAL-SPACE WINDOW ACCORDINGLY, AND DRAW AND LABEL THE AXES 

THE NEGATIVE UALUES FOR THE STARTING POINTS OF TIC WINDOW LEAUE 
A BORDER AROUND THE AXES FOR LABEL I NG AND CAUSE THE ORIGN OF 
THE AXES TO BE AT (0.0, 0.0). THE X-AXIS IS IN ‘INCHES’, THE 
Y-AXIS ALLOWS FOR UALUES 0. 0-1.0. 

20 NSCNPI = 10 * NSCALE 

CTNNp I = NSTNP I 

IREM1 = M00(KSCAN( ISCSTR ), NSCNPI ) 

IREM2 = NSCNPI - MOD(KSCAN(NSCN), NSCNPI ) 

XLNGTH = (KSCAN(NSCN) - KSCAN( ISCSTR) + IREM1 + IREM2)/SCNNPI 

IF (XLNGTH LE. 0.0) GO TO MO 

NSTART = KSCAN( ISCSTR) - IREM1 

RKSCAN = NSTART 

YLNGTH = 9.0 

YSIZE = 11.0 

XBMRGN = ((YSIZE - YLNGTH) /YLNGTH )*0. 6250 
XTMRGN = 1.0 + XBMRGN+O . 60 
YLMRGN = 3.0 
YRMRGN * 3.0 

ENDPLT * XLNGTH + YRMRGN 
XPLT = ENOPLT + YLMRGN 
CALL UDIMEN(XPLT,YSIZE) 

CALL UU I NOO < -YLMRGN , ENDPLT , -XBMRGN , XTMRGN ) 

XPLT 1 = XPLT - 0.001 

YSIZE1 * YSIZE - 0.001 
CALL UUtPRT (0.0, XPLT 1,0.0, YSIZE 1 ) 


non non non 


COLL UMOUECO. 0,0.0) 

CALL U0RAU<XLNGTH,0.0) 

CALL UDRAW<XLNGTH, 1.0) 

CALL U0RRW<0.0, 1.0) 

CALL UORAUCO. 0,0.0) 

TICK MARKS, NUMERIC AXES LABELS, AND CHANNEL /SYMBOL TABLES 

XTMLN1 = 0. 1500 / YLNGTH 
XTMLN2 = 0.4000 * XTffl.N1 
VTMLN1 = 0.2500 
YTMLN2 = VTMLN1 / 2.0 
XNUMDX = 0.0750 
XNUMDY =0.1250/ YSIZE 
VNLflIDX = 0.5500 
YNUTEY = 0.0625 / YSIZE 
CALL USET< 'MED 1 1 ) 

CHANNEL/SYfBOL TABLE, LEFT 

XPOS = -YLMRGN 
YPOS = 0.94 

CALL UM0UE<XP0S, YPOS ) 

CALL UPRNTK’ FLIGHT $‘,'TEXT') 

URITECCFLT, 1000) NFLT 
CALL UPRNTKCFLT, 'TEXT' ) 

YPOS = 0.8 

CALL Uf10UE< XPOS, YPOS) 

CALL USETCUNDE' ) 

CALL UPRNTK 'CHAN$', 'TEXT' ) 

CALL UPRNTK' 'TEXT' ) 

CALL IPRNT 1 < ' SYN$ ' , ' TEXT ' ) 

CALL USET< 'NOUN' ) 

CALL USET < ‘ NSYM * ) 

XP0S1 * XPOS + 1.00 
DO 30 1C = 1,8 
S s ic 

IF <IC .GT. 6) S = S + 1.0 
YPOS = YPOS - 4.0+YNUMDY 
YP0S1 = YPOS + 1 . 0*YNUMDV 
CALL UMOUE( XPOS, YPOS) 

CALL UPRNTKCHAN< IC),’ ‘TEXT* ) 

CALL UPSET < ' SYMB ' , S > 

CALL UPEN< XPOS 1 , YPOS 1 ) 

30 CONTINUE 

Y-AXIS, LEFT 

XPOS = 0.0 

YPOS = 0.0 

YNUMX = XPOS - YNUMDX 

YNUMY = YPOS - YNUMDY 

CALL UPR I NT(YNUMX, YNUMY, TENTHS < 1 )) 

DO 50 IV1 = 1, 10 
DO 40 IV2 = 1,9 

YPOS = YPOS + 0.0100 
CALL lff10UE( XPOS, YPOS) 

CALL UDRAU ( YTMLN2 , YPOS ) 



non o o o 


40 CONTINUE 

VPOS = VPOS + 0.0100 
VNUMV * VPOS - VNUMDV 
CALL UPR I NT(VTRJMX,YNUMV, TENTHS ( IV1+1 )) 

CALL OMOUE(XPOS,VPOS) 

CALL UDRAU( VTMLN 1 , VPOS ) 

50 CONTINUE 

X-AXIS, TOP 

XPOS = 0.0 

VPOS = 1.0 

CALL UMOUE(XPOS,VPOS) 

CALL USET < 'SOFT' > 

CALL USET (’ INTE' > 

CALL UPSET< 'ANGL' ,90.0) 

XHORZ = 0.1500 / VSIZE 

XUERT =0.1875 

CALL UPSET ( 'HORI ' , XHORZ) 

CALL UPSET < ' UERT ' , XUERT > 

XNUNX * XPOS + XNUNDX 

XNUMV = VPOS + XNUMOV 

CALL IFR I NT (XNUNX, XNUMV, RKSCAN) 

VP0S1 = VPOS - XTMLN1 

VP0S2 = VPOS - XTMLN2 

NXTICK = XLNGTH + 0.01 
CALL UPSETCSVMB',4.0) 

CALL USET < ' NSVM ' ) 

DO 80 1X1 = 1, NXTICK 
DO 60 1X2 = 1,9 
XPOS = XPOS + 0. 1 
CALL UNOUE< XPOS, VPOS) 

CALL UORAU(XPOS, VP0S2 > 

60 CONTINUE 

XPOS = 1X1 
XNUNX = XPOS + XNUNDX 
RKSCAN = RKSCAN + SCNNPI 
CALL UPR I NT<XNUMX, XNUMV, RKSCAN) 

CALL UNOUE< XPOS, VPOS) 

CALL UDRAU(XPOS, VP0S1 ) 

IF (0100(1X1,10) .NE. 0) .TO. (1X1 .EQ. XLNGTH)) GO TO 80 
VPLUS = 1.0 
DO 70 I PLUS = 1,9 

CALL UM0UE( XPOS, VPLUS) 

VPLUS = VPLUS - 0. 10 
CALL UPEN(XPOS, VPLUS) 

70 CONTINUE 

80 CONTINUE 

CALL USET CHARD' ) 

CALL USET ('TEXT') 

CALL UPSETC ANGL ',0.0) 

CHANNEL /SVMBOL TABLE, RIGHT 

XPOS = ENDPLT - 1.75 

VPOS = 0.94 

CALL UM0UE(XP0S,VP0S) 

CALL UPRNTK 'FLIGHT $','TEXT') 


o o o o o non 


CflLL UPRNTKCFLT, 'TEXT 1 ) 

VPOS * 0.8 

CflLL UMOUE<XPOS,VPOS> 

CRLL USETCUNOE’) 

CflLL UPRNT1<’CHflN$', ’TEXT' ) 

CflLL UPRNTK 1 $ ’ , ' TEXT ’ > 

CflLL IPRNT 1 < ' SVM$ ' , ' TEXT ' ) 

CflLL USET < ' NOUN ' ) 

CflLL USET < ' NSVM ' ) 

XP0S1 = XROS + 1.00 
DO 90 1C * 1,8 
S * 1C 

IF CIC .GT. 6) S * S + 1.0 
VPOS = VPOS - 4.0*VNUMDV 
VP0S1 * VPOS + 1 .0*VNUMDV 
CflLL UMOUE<XPOS,VPOS> 

CflLL UPRNTKCHfflKIC), ’TEXT’) 

CflLL UPSET CSVMB',S) 

CflLL IFEN<XP0S 1 , VPOS 1 ) 

90 CONTINUE 

V-RXIS, RIGHT 

VPOS = 1.0 

XP0S1 = XLHGTH - VT1fl.N1 

XP0S2 = XLHGTH - VTNLN2 

VNUHX * XLHGTH + 0.1250 

VNUHV = VPOS - VHUHDV 

CflLL UPRINT<VNUMX,VNUMV,TENTHS<11>> 

00 110 IV1 * 1,10 
DO 100 IV2 = 1,9 

VPOS = VPOS - 0.0100 
CflLL UMOUE<XLNGTH,VPOS> 

CflLL U0RflU<XP0S2, VPOS ) 

100 CONTINUE 

VPOS = VPOS - 0.0100 
VNUHV * VPOS - VNUHDV 
CflLL UPR I NT<VNUMX, VNUHV, TENTHS < 1 1-1 VI )) 

CflLL UMOUE<XLNGTH,VPOS> 

CfflJ. IfflRflWCXPOS 1 , VPOS > 

110 CONTINUE 

X-flXIS, BOTTOH 

XPOS = XLNGTH 
VPOS =0.0 
DO 130 1X1 = 1 , NXT I CK 
DO 120 1X2 = 1,9 
XPOS = XPOS - 0. 1 
CflLL UNDUE < XPOS, VPOS) 

CflLL U0RflW<XP0S,XTMLN2> 

120 CONTINUE 

XPOS = XLNGTH - 1X1 
CflLL UHOUE< XPOS, VPOS) 

CflLL UDRflU<XP0S,XTMLN1 ) 

130 CONTINUE 

LABEL TIME AXIS WHERE TIMES ARE AUAILABLE AND AT LEAST SOME 



ooo onooo oo 


DATA IS GOOD 

CALL USET < ' SOFT ' ) 

CALL UPSET < ' ANGL ’,90.0) 

XHORZ = 0. 1500 / VSIZE 

XUERT = 0. 1875 

CALL UPSET < ' HOR I ' , XHORZ ) 

CALL UPSET < ' UERT ' , XUERT ) 

TIMEV * -XHORZ *9.0 
DO 160 MS = I SCSTR, NSCN 

IF <MOD<KSCAN<NS ),NSCNP I ) .NE. 0> GO TO 160 
DO 140 I = 1,8 

IF <<PHI <NS, I ) GT. 0.0) .AMD. <PHI<MS,I> LT. 1.0)) 

1 GO TO 150 

140 COMTIMUE 

GO TO 160 

150 XPOS = <KSCAH<MS) - HSTART) / SCMMPI 
TIMEX = XPOS + XNUMOX 
CRLL UMOUE<TIMEX,TIMEY> 

URITE<CHR, 1010) ITIME<MS, 1) 

HRITE<CMN, 1010) ITIME<NS,2) 

URITE<CSC, 1010) ITIME<NS,3) 

CALL UPRNTKCHR, 'TEXT' ) 

CALL UPRMT 1 <CLM, ' TEXT ' ) 

CALL UPRMT KCMM, ’TEXT’) 

CALL UPRMTKCLM, ‘TEXT’ ) 

CALL UPRNTKCSC, 'TEXT 1 > 

160 COMTIMUE 

CALL USET THARD- ) 

CALL UPSET< 'AMGL' ,0.0) 

PLOT DATA FOR EACH CHANNEL UHEM 0.0 < PHI < 1.0 

CYCLE OM CHANNEL 

00 210 1C = 1,8 
S = 1C 

IF <IC .GT. 6) S = S + 1.0 

XPOS = -0. 1 

YPOS = 0.0 

NGOOD = -1 

CALL USET < 1 NSVM" ) 

CALL LPSET < 1 SVMB ' , S ) 

CALL UMOUE<XPOS,YPOS) 

FIND FIRST GOOD DATA UALUE FOR THIS CHANNEL AMD PLOT SYMBOL 

DO 170 NS = ISCSTR,NSCN 

IF <IC .EQ. 8) 1 1C * ICH8<NS) 

IF <<IC EQ. 8) .AMD. < 1 1C ,EQ. 7)) GO TO 170 
N = NS 

IF <<PHI<MS, 1C) GT. 0.0) .AMD. <PHI<NS,IC) .LT. 1.0)) THEN 
GO TO 180 
END IF 
170 CONTINUE 

GO TO 210 

180 XPOS = <KSCRM<N) - NSTART ) / SCNNPI 
NGOOO = NGOOD + 1 


non 


CALL UPEN<XPOS,PHI<N, IO) 

PLOT REST OF GOOD DATA FOR THIS CHANNEL 

NSP1 = N + 1 
CALL USETCLNUL 1 ) 

DO 200 NS = NSP1.NSCN 

IF <<PHI<NSJO LE. 0.0) .OR. <PHI<NS / IC) .GE. 1.0)) 

1 GO TO 190 

NGOOO = NGOOO + 1 
IF <IC .NE. 8) THEN 

IF <<<NS+1 ) .LE. NSCN) AND. 

1 <<PHI <NS+1, 1C) .LE. 0.0) OR. 

2 <PHI <NS+1, 1C) .GE. 1.0>)> CALL USET<’LSVN') 

IF <<<NS+1 ) .LE. NSCN) .AND. 

1 <<KSCAN<NS+1 ) - KSCAN<NS)) NE. 1)) 

2 CALL USET < ’ LSVH ' ) 

IF <<M0D<NG000,5) .EQ. 0) ANO.< NGOOO .IE. 0)) THEN 
CALL USET <‘ LSVH 1 ) 

NGOOO = 0 
END IF 
ELSE 

IIC = ICH8<NS) 

IF <1 1C .EQ. 7) GO TO 190 
NIIC = 7 

IF <<NS+1 ) .LE. NSCN) NIIC = ICH8<NS+1) 

IF < NGOOO .GE. 1) THEN 

IF <NIIC EQ. 7) CALL USET<'LSYH’> 

IF <«NS+1 > LE. NSCN) AND. 

1 <<PHI<NS+1 JC) LE. 0.0) OR. 

2 <PHI<NS+1,IC) GE. 1.0))) CALL USET<'LSVN‘) 
IF < < <NS+ 1 > LE. NSCN) AND. 

1 <<KSCAN<NS+1) - KSCAN<NS>) .NE. D) 

2 CALL USET< 'LSVM' ) 

END IF 

END IF 

IF << <I<SCAN<NS ) - KSCAN<NS-1 )) NE. 1) OR. 

1 <PHI <NS-1, IC> .LE. 0.0) OR. 

2 <PHI<NS-1,IC) .GE. 1.0)) THEN 
NGOOD = 0 

CALL USET < ' NSVH ' ) 

END IF 

IF <NS .EQ. NSCN) THEN 
CALL USET < ' LSVM ' ) 

IF << <I<SCAN<NS ) - KSCAN<NS-1 )) .NE. 1) .OR. 

1 <PHI <NS-1, IC> .LE. 0.0) .OR. 

2 <PHI<NS-1,IC) .GE. 1 ,0» CALL USET< ‘NSTH’ ) 

END IF 

XPOS = <KSCAN<NS) - NSTART) / SCNNPI 
Cffl.L UPEN<XPOS,PHI<NS, IC>> 

IF <<IC EQ. 8) .AND. <NIIC .EQ. 7» GO TO 190 
CALL USET < ' LNUL ' ) 

GO TO 20) 

190 NGOOD = -1 

CALL USET < ‘ NSVM ' ) 

20) CONTINUE 

210 CONTINUE 
XPOS = XPLT 


VPOS ■ XBMRGM 

CRLL UNOOE<XPOS,VPOS> 

CflLL UERflSE 

IF < INDEX EQ. IFfiSS) CRLL UEf© 

GO TO 999 

900 NSCM1 = NSCflN<NPfiSS) 

URITE<6, 1020) XLNGTH,NSCN,NSCN1, <NS,KSCRN(NS),NS=ISCSTR,NSCN1 ) 
CRLL UERflSE 
999 RETURN 
1000 F0RMRT(I4, 1H$) 

1010 F0RHRTCI2, 1H$) 

1020 FORMRT< 1H1, /,27H THE X LENGTH OF THE PLOT =, 1P,E12.4,//, 

1 42H THE INDEX OF THE LRST URL ID SCRN NUNBER =, 15,//, 

2 42H THE INDEX OF THE LRST SCRN NUNBER =, 15, //, 

3 30H THE RRRRV OF SCRN NltlBERS IS:,/, 

4 <15,18,/)) 

END 
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